- width = 0;
- if (*name_idx >= fx->name_cnt)
- {
- msg (SE, _("The number of format "
- "specifications exceeds the given number of "
- "variable names."));
- return 0;
- }
-
- v = dict_create_var (default_dict, fx->name[(*name_idx)++], width);
- if (!v)
- {
- msg (SE, _("%s is a duplicate variable name."), fx->name[i]);
- return 0;
- }
-
- spec = xmalloc (sizeof *spec);
- spec->v = v;
- spec->input = f->f;
- spec->fv = v->fv;
- spec->rec = fx->recno;
- spec->fc = fx->sc;
- spec->lc = fx->sc + f->f.w - 1;
- append_var_spec (first, last, spec);
-
- convert_fmt_ItoO (&spec->input, &v->print);
- v->write = v->print;
-
- fx->sc += f->f.w;
- }
- return 1;
-}
-
-/* Recursively parses a FORTRAN-like format specification into
- the linked list with head FIRST and tail TAIL. LEVEL is the
- level of recursion, starting from 0. Returns the parsed
- specification if successful, or a null pointer on failure. */
-static struct fmt_list *
-fixed_parse_fortran_internal (struct fixed_parsing_state *fx,
- struct dls_var_spec **first,
- struct dls_var_spec **last)
-{
- struct fmt_list *head = NULL;
- struct fmt_list *tail = NULL;
-
- lex_force_match ('(');
- while (token != ')')
- {
- /* New fmt_list. */
- struct fmt_list *new = xmalloc (sizeof *new);
- new->next = NULL;
-
- /* Append new to list. */
- if (head != NULL)
- tail->next = new;
- else
- head = new;
- tail = new;
-
- /* Parse count. */
- if (lex_is_integer ())
- {
- new->count = lex_integer ();
- lex_get ();
- }
- else
- new->count = 1;
-
- /* Parse format specifier. */
- if (token == '(')
- {
- new->f.type = FMT_DESCEND;
- new->down = fixed_parse_fortran_internal (fx, first, last);
- if (new->down == NULL)
- goto fail;
- }
- else if (lex_match ('/'))
- new->f.type = FMT_NEWREC;
- else if (!parse_format_specifier (&new->f, FMTP_ALLOW_XT)
- || !check_input_specifier (&new->f, 1))
- goto fail;
-
- lex_match (',');
- }
- lex_force_match (')');
-
- return head;
-
-fail:
- destroy_fmt_list (head, 0);
-
- return NULL;
-}
-
-/* Parses a FORTRAN-like format specification into the linked
- list with head FIRST and tail LAST. Returns nonzero if
- successful. */
-static int
-fixed_parse_fortran (struct fixed_parsing_state *fx,
- struct dls_var_spec **first, struct dls_var_spec **last)
-{
- struct fmt_list *list;
- int name_idx;
-
- list = fixed_parse_fortran_internal (fx, first, last);
- if (list == NULL)
- return 0;
-
- name_idx = 0;
- dump_fmt_list (fx, list, first, last, &name_idx);
- destroy_fmt_list (list, 1);
- if (name_idx < fx->name_cnt)
- {
- msg (SE, _("There aren't enough format specifications "
- "to match the number of variable names given."));
- return 0;
- }
-
- return 1;
-}
-
-/* Displays a table giving information on fixed-format variable
- parsing on DATA LIST. */
-/* FIXME: The `Columns' column should be divided into three columns,
- one for the starting column, one for the dash, one for the ending
- column; then right-justify the starting column and left-justify the
- ending column. */
-static void
-dump_fixed_table (const struct dls_var_spec *specs,
- const struct file_handle *fh, int rec_cnt)
-{
- const struct dls_var_spec *spec;
- struct tab_table *t;
- int i;
-
- for (i = 0, spec = specs; spec; spec = spec->next)
- i++;
- t = tab_create (4, i + 1, 0);
- tab_columns (t, TAB_COL_DOWN, 1);
- tab_headers (t, 0, 0, 1, 0);
- tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
- tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
- tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
- tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
- tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, i);
- tab_hline (t, TAL_2, 0, 3, 1);
- tab_dim (t, tab_natural_dimensions);
-
- for (i = 1, spec = specs; spec; spec = spec->next, i++)
- {
- tab_text (t, 0, i, TAB_LEFT, spec->v->name);
- tab_text (t, 1, i, TAT_PRINTF, "%d", spec->rec);
- tab_text (t, 2, i, TAT_PRINTF, "%3d-%3d",
- spec->fc, spec->lc);
- tab_text (t, 3, i, TAB_LEFT | TAB_FIX,
- fmt_to_string (&spec->input));
+ {
+ /* Failure.
+ This can be acceptable if we're in INPUT
+ PROGRAM, but only if the existing variable has
+ the same width as the one we would have
+ created. */
+ if (!in_input_program ())
+ {
+ msg (SE, _("%s is a duplicate variable name."), name);
+ return false;
+ }
+
+ v = dict_lookup_var_assert (dict, name);
+ if ((width != 0) != (var_get_width (v) != 0))
+ {
+ msg (SE, _("There is already a variable %s of a "
+ "different type."),
+ name);
+ return false;
+ }
+ if (width != 0 && width != var_get_width (v))
+ {
+ msg (SE, _("There is already a string variable %s of a "
+ "different width."), name);
+ return false;
+ }
+ }
+
+ if (max_records && record > max_records)
+ {
+ msg (SE, _("Cannot place variable %s on record %d when "
+ "RECORDS=%d is specified."),
+ var_get_name (v), record,
+ data_parser_get_records (parser));
+ }
+
+ data_parser_add_fixed_field (parser, f,
+ var_get_case_index (v),
+ var_get_name (v), record, column);
+
+ column += f->w;
+ }
+ assert (name_idx == n_names);