src/data-list.c

   1 /* PSPP - computes sample statistics.
   2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
   3    Written by Ben Pfaff <blp@gnu.org>.
   4
   5    This program is free software; you can redistribute it and/or
   6    modify it under the terms of the GNU General Public License as
   7    published by the Free Software Foundation; either version 2 of the
   8    License, or (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful, but
  11    WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13    General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  18    02110-1301, USA. */
  19
  20 #include <config.h>
  21 #include "data-list.h"
  22 #include "error.h"
  23 #include <ctype.h>
  24 #include <float.h>
  25 #include <stdio.h>
  26 #include <stdlib.h>
  27 #include "alloc.h"
  28 #include "case.h"
  29 #include "command.h"
  30 #include "data-in.h"
  31 #include "debug-print.h"
  32 #include "dfm-read.h"
  33 #include "dictionary.h"
  34 #include "error.h"
  35 #include "file-handle.h"
  36 #include "format.h"
  37 #include "lexer.h"
  38 #include "misc.h"
  39 #include "settings.h"
  40 #include "str.h"
  41 #include "tab.h"
  42 #include "var.h"
  43 #include "vfm.h"
  44 \f
  45 /* Utility function. */
  46
  47 /* FIXME: Either REPEATING DATA must be the last transformation, or we
  48    must multiplex the transformations that follow (i.e., perform them
  49    for every case that we produce from a repetition instance).
  50    Currently we do neither.  We should do one or the other. */
  51
  52 /* Describes how to parse one variable. */
  53 struct dls_var_spec
  54   {
  55     struct dls_var_spec *next;  /* Next specification in list. */
  56
  57     /* Both free and fixed formats. */
  58     struct fmt_spec input;      /* Input format of this field. */
  59     struct variable *v;         /* Associated variable.  Used only in
  60                                    parsing.  Not safe later. */
  61     int fv;                     /* First value in case. */
  62
  63     /* Fixed format only. */
  64     int rec;                    /* Record number (1-based). */
  65     int fc, lc;                 /* Column numbers in record. */
  66
  67     /* Free format only. */
  68     char name[LONG_NAME_LEN + 1]; /* Name of variable. */
  69   };
  70
  71 /* Constants for DATA LIST type. */
  72 /* Must match table in cmd_data_list(). */
  73 enum
  74   {
  75     DLS_FIXED,
  76     DLS_FREE,
  77     DLS_LIST
  78   };
  79
  80 /* DATA LIST private data structure. */
  81 struct data_list_pgm
  82   {
  83     struct trns_header h;
  84
  85     struct dls_var_spec *first, *last;  /* Variable parsing specifications. */
  86     struct dfm_reader *reader;  /* Data file reader. */
  87
  88     int type;                   /* A DLS_* constant. */
  89     struct variable *end;       /* Variable specified on END subcommand. */
  90     int eof;                    /* End of file encountered. */
  91     int rec_cnt;                /* Number of records. */
  92     size_t case_size;           /* Case size in bytes. */
  93     char *delims;               /* Delimiters if any; not null-terminated. */
  94     size_t delim_cnt;           /* Number of delimiter, or 0 for spaces. */
  95   };
  96
  97 static int parse_fixed (struct data_list_pgm *);
  98 static int parse_free (struct dls_var_spec **, struct dls_var_spec **);
  99 static void dump_fixed_table (const struct dls_var_spec *,
 100                               const struct file_handle *, int rec_cnt);
 101 static void dump_free_table (const struct data_list_pgm *,
 102                              const struct file_handle *);
 103 static void destroy_dls_var_spec (struct dls_var_spec *);
 104 static trns_free_func data_list_trns_free;
 105 static trns_proc_func data_list_trns_proc;
 106
 107 /* Message title for REPEATING DATA. */
 108 #define RPD_ERR "REPEATING DATA: "
 109
 110 int
 111 cmd_data_list (void)
 112 {
 113   struct data_list_pgm *dls;     /* DATA LIST program under construction. */
 114   int table = -1;                /* Print table if nonzero, -1=undecided. */
 115   struct file_handle *fh = NULL; /* File handle of source, NULL=inline file. */
 116
 117   if (!case_source_is_complex (vfm_source))
 118     discard_variables ();
 119
 120   dls = xmalloc (sizeof *dls);
 121   dls->reader = NULL;
 122   dls->type = -1;
 123   dls->end = NULL;
 124   dls->eof = 0;
 125   dls->rec_cnt = 0;
 126   dls->delims = NULL;
 127   dls->delim_cnt = 0;
 128   dls->first = dls->last = NULL;
 129
 130   while (token != '/')
 131     {
 132       if (lex_match_id ("FILE"))
 133         {
 134           lex_match ('=');
 135           fh = fh_parse ();
 136           if (fh == NULL)
 137             goto error;
 138           if (case_source_is_class (vfm_source, &file_type_source_class)
 139               && fh != default_handle)
 140             {
 141               msg (SE, _("DATA LIST may not use a different file from "
 142                          "that specified on its surrounding FILE TYPE."));
 143               goto error;
 144             }
 145         }
 146       else if (lex_match_id ("RECORDS"))
 147         {
 148           lex_match ('=');
 149           lex_match ('(');
 150           if (!lex_force_int ())
 151             goto error;
 152           dls->rec_cnt = lex_integer ();
 153           lex_get ();
 154           lex_match (')');
 155         }
 156       else if (lex_match_id ("END"))
 157         {
 158           if (dls->end)
 159             {
 160               msg (SE, _("The END subcommand may only be specified once."));
 161               goto error;
 162             }
 163
 164           lex_match ('=');
 165           if (!lex_force_id ())
 166             goto error;
 167           dls->end = dict_lookup_var (default_dict, tokid);
 168           if (!dls->end)
 169             dls->end = dict_create_var_assert (default_dict, tokid, 0);
 170           lex_get ();
 171         }
 172       else if (token == T_ID)
 173         {
 174           if (lex_match_id ("NOTABLE"))
 175             table = 0;
 176           else if (lex_match_id ("TABLE"))
 177             table = 1;
 178           else
 179             {
 180               int type;
 181               if (lex_match_id ("FIXED"))
 182                 type = DLS_FIXED;
 183               else if (lex_match_id ("FREE"))
 184                 type = DLS_FREE;
 185               else if (lex_match_id ("LIST"))
 186                 type = DLS_LIST;
 187               else
 188                 {
 189                   lex_error (NULL);
 190                   goto error;
 191                 }
 192
 193               if (dls->type != -1)
 194                 {
 195                   msg (SE, _("Only one of FIXED, FREE, or LIST may "
 196                              "be specified."));
 197                   goto error;
 198                 }
 199               dls->type = type;
 200
 201               if ((dls->type == DLS_FREE || dls->type == DLS_LIST)
 202                   && lex_match ('('))
 203                 {
 204                   while (!lex_match (')'))
 205                     {
 206                       int delim;
 207
 208                       if (lex_match_id ("TAB"))
 209                         delim = '\t';
 210                       else if (token == T_STRING && tokstr.length == 1)
 211                         {
 212                           delim = tokstr.string[0];
 213                           lex_get();
 214                         }
 215                       else
 216                         {
 217                           lex_error (NULL);
 218                           goto error;
 219                         }
 220
 221                       dls->delims = xrealloc (dls->delims, dls->delim_cnt + 1);
 222                       dls->delims[dls->delim_cnt++] = delim;
 223
 224                       lex_match (',');
 225                     }
 226                 }
 227             }
 228         }
 229       else
 230         {
 231           lex_error (NULL);
 232           goto error;
 233         }
 234     }
 235
 236   dls->case_size = dict_get_case_size (default_dict);
 237   default_handle = fh;
 238
 239   if (dls->type == -1)
 240     dls->type = DLS_FIXED;
 241
 242   if (table == -1)
 243     {
 244       if (dls->type == DLS_FREE)
 245         table = 0;
 246       else
 247         table = 1;
 248     }
 249
 250   if (dls->type == DLS_FIXED)
 251     {
 252       if (!parse_fixed (dls))
 253         goto error;
 254       if (table)
 255         dump_fixed_table (dls->first, fh, dls->rec_cnt);
 256     }
 257   else
 258     {
 259       if (!parse_free (&dls->first, &dls->last))
 260         goto error;
 261       if (table)
 262         dump_free_table (dls, fh);
 263     }
 264
 265   dls->reader = dfm_open_reader (fh);
 266   if (dls->reader == NULL)
 267     goto error;
 268
 269   if (vfm_source != NULL)
 270     {
 271       dls->h.proc = data_list_trns_proc;
 272       dls->h.free = data_list_trns_free;
 273       add_transformation (&dls->h);
 274     }
 275   else
 276     vfm_source = create_case_source (&data_list_source_class, dls);
 277
 278   return CMD_SUCCESS;
 279
 280  error:
 281   destroy_dls_var_spec (dls->first);
 282   free (dls->delims);
 283   free (dls);
 284   return CMD_FAILURE;
 285 }
 286
 287 /* Adds SPEC to the linked list with head at FIRST and tail at
 288    LAST. */
 289 static void
 290 append_var_spec (struct dls_var_spec **first, struct dls_var_spec **last,
 291                  struct dls_var_spec *spec)
 292 {
 293   spec->next = NULL;
 294
 295   if (*first == NULL)
 296     *first = spec;
 297   else
 298     (*last)->next = spec;
 299   *last = spec;
 300 }
 301 \f
 302 /* Fixed-format parsing. */
 303
 304 /* Used for chaining together fortran-like format specifiers. */
 305 struct fmt_list
 306   {
 307     struct fmt_list *next;
 308     int count;
 309     struct fmt_spec f;
 310     struct fmt_list *down;
 311   };
 312
 313 /* State of parsing DATA LIST. */
 314 struct fixed_parsing_state
 315   {
 316     char **name;                /* Variable names. */
 317     int name_cnt;               /* Number of names. */
 318
 319     int recno;                  /* Index of current record. */
 320     int sc;                     /* 1-based column number of starting column for
 321                                    next field to output. */
 322   };
 323
 324 static int fixed_parse_compatible (struct fixed_parsing_state *,
 325                                    struct dls_var_spec **,
 326                                    struct dls_var_spec **);
 327 static int fixed_parse_fortran (struct fixed_parsing_state *,
 328                                 struct dls_var_spec **,
 329                                 struct dls_var_spec **);
 330
 331 /* Parses all the variable specifications for DATA LIST FIXED,
 332    storing them into DLS.  Returns nonzero if successful. */
 333 static int
 334 parse_fixed (struct data_list_pgm *dls)
 335 {
 336   struct fixed_parsing_state fx;
 337   int i;
 338
 339   fx.recno = 0;
 340   fx.sc = 1;
 341
 342   while (token != '.')
 343     {
 344       while (lex_match ('/'))
 345         {
 346           fx.recno++;
 347           if (lex_is_integer ())
 348             {
 349               if (lex_integer () < fx.recno)
 350                 {
 351                   msg (SE, _("The record number specified, %ld, is "
 352                              "before the previous record, %d.  Data "
 353                              "fields must be listed in order of "
 354                              "increasing record number."),
 355                        lex_integer (), fx.recno - 1);
 356                   return 0;
 357                 }
 358
 359               fx.recno = lex_integer ();
 360               lex_get ();
 361             }
 362           fx.sc = 1;
 363         }
 364
 365       if (!parse_DATA_LIST_vars (&fx.name, &fx.name_cnt, PV_NONE))
 366         return 0;
 367
 368       if (lex_is_number ())
 369         {
 370           if (!fixed_parse_compatible (&fx, &dls->first, &dls->last))
 371             goto fail;
 372         }
 373       else if (token == '(')
 374         {
 375           if (!fixed_parse_fortran (&fx, &dls->first, &dls->last))
 376             goto fail;
 377         }
 378       else
 379         {
 380           msg (SE, _("SPSS-like or FORTRAN-like format "
 381                      "specification expected after variable names."));
 382           goto fail;
 383         }
 384
 385       for (i = 0; i < fx.name_cnt; i++)
 386         free (fx.name[i]);
 387       free (fx.name);
 388     }
 389   if (dls->first == NULL)
 390     {
 391       msg (SE, _("At least one variable must be specified."));
 392       return 0;
 393     }
 394   if (dls->rec_cnt && dls->last->rec > dls->rec_cnt)
 395     {
 396       msg (SE, _("Variables are specified on records that "
 397                  "should not exist according to RECORDS subcommand."));
 398       return 0;
 399     }
 400   else if (!dls->rec_cnt)
 401     dls->rec_cnt = dls->last->rec;
 402   return lex_end_of_command () == CMD_SUCCESS;
 403
 404 fail:
 405   for (i = 0; i < fx.name_cnt; i++)
 406     free (fx.name[i]);
 407   free (fx.name);
 408   return 0;
 409 }
 410
 411 /* Parses a variable specification in the form 1-10 (A) based on
 412    FX and adds specifications to the linked list with head at
 413    FIRST and tail at LAST. */
 414 static int
 415 fixed_parse_compatible (struct fixed_parsing_state *fx,
 416                         struct dls_var_spec **first, struct dls_var_spec **last)
 417 {
 418   struct fmt_spec input;
 419   int fc, lc;
 420   int width;
 421   int i;
 422
 423   /* First column. */
 424   if (!lex_force_int ())
 425     return 0;
 426   fc = lex_integer ();
 427   if (fc < 1)
 428     {
 429       msg (SE, _("Column positions for fields must be positive."));
 430       return 0;
 431     }
 432   lex_get ();
 433
 434   /* Last column. */
 435   lex_negative_to_dash ();
 436   if (lex_match ('-'))
 437     {
 438       if (!lex_force_int ())
 439         return 0;
 440       lc = lex_integer ();
 441       if (lc < 1)
 442         {
 443           msg (SE, _("Column positions for fields must be positive."));
 444           return 0;
 445         }
 446       else if (lc < fc)
 447         {
 448           msg (SE, _("The ending column for a field must be "
 449                      "greater than the starting column."));
 450           return 0;
 451         }
 452
 453       lex_get ();
 454     }
 455   else
 456     lc = fc;
 457
 458   /* Divide columns evenly. */
 459   input.w = (lc - fc + 1) / fx->name_cnt;
 460   if ((lc - fc + 1) % fx->name_cnt)
 461     {
 462       msg (SE, _("The %d columns %d-%d "
 463                  "can't be evenly divided into %d fields."),
 464            lc - fc + 1, fc, lc, fx->name_cnt);
 465       return 0;
 466     }
 467
 468   /* Format specifier. */
 469   if (lex_match ('('))
 470     {
 471       struct fmt_desc *fdp;
 472
 473       if (token == T_ID)
 474         {
 475           const char *cp;
 476
 477           input.type = parse_format_specifier_name (&cp, 0);
 478           if (input.type == -1)
 479             return 0;
 480           if (*cp)
 481             {
 482               msg (SE, _("A format specifier on this line "
 483                          "has extra characters on the end."));
 484               return 0;
 485             }
 486
 487           lex_get ();
 488           lex_match (',');
 489         }
 490       else
 491         input.type = FMT_F;
 492
 493       if (lex_is_integer ())
 494         {
 495           if (lex_integer () < 1)
 496             {
 497               msg (SE, _("The value for number of decimal places "
 498                          "must be at least 1."));
 499               return 0;
 500             }
 501
 502           input.d = lex_integer ();
 503           lex_get ();
 504         }
 505       else
 506         input.d = 0;
 507
 508       fdp = &formats[input.type];
 509       if (fdp->n_args < 2 && input.d)
 510         {
 511           msg (SE, _("Input format %s doesn't accept decimal places."),
 512                fdp->name);
 513           return 0;
 514         }
 515
 516       if (input.d > 16)
 517         input.d = 16;
 518
 519       if (!lex_force_match (')'))
 520         return 0;
 521     }
 522   else
 523     {
 524       input.type = FMT_F;
 525       input.d = 0;
 526     }
 527   if (!check_input_specifier (&input, 1))
 528     return 0;
 529
 530   /* Start column for next specification. */
 531   fx->sc = lc + 1;
 532
 533   /* Width of variables to create. */
 534   if (input.type == FMT_A || input.type == FMT_AHEX)
 535     width = input.w;
 536   else
 537     width = 0;
 538
 539   /* Create variables and var specs. */
 540   for (i = 0; i < fx->name_cnt; i++)
 541     {
 542       struct dls_var_spec *spec;
 543       struct variable *v;
 544
 545       v = dict_create_var (default_dict, fx->name[i], width);
 546       if (v != NULL)
 547         {
 548           convert_fmt_ItoO (&input, &v->print);
 549           v->write = v->print;
 550           if (!case_source_is_complex (vfm_source))
 551             v->init = 0;
 552         }
 553       else
 554         {
 555           v = dict_lookup_var_assert (default_dict, fx->name[i]);
 556           if (vfm_source == NULL)
 557             {
 558               msg (SE, _("%s is a duplicate variable name."), fx->name[i]);
 559               return 0;
 560             }
 561           if ((width != 0) != (v->width != 0))
 562             {
 563               msg (SE, _("There is already a variable %s of a "
 564                          "different type."),
 565                    fx->name[i]);
 566               return 0;
 567             }
 568           if (width != 0 && width != v->width)
 569             {
 570               msg (SE, _("There is already a string variable %s of a "
 571                          "different width."), fx->name[i]);
 572               return 0;
 573             }
 574         }
 575
 576       spec = xmalloc (sizeof *spec);
 577       spec->input = input;
 578       spec->v = v;
 579       spec->fv = v->fv;
 580       spec->rec = fx->recno;
 581       spec->fc = fc + input.w * i;
 582       spec->lc = spec->fc + input.w - 1;
 583       append_var_spec (first, last, spec);
 584     }
 585   return 1;
 586 }
 587
 588 /* Destroy format list F and, if RECURSE is nonzero, all its
 589    sublists. */
 590 static void
 591 destroy_fmt_list (struct fmt_list *f, int recurse)
 592 {
 593   struct fmt_list *next;
 594
 595   for (; f; f = next)
 596     {
 597       next = f->next;
 598       if (recurse && f->f.type == FMT_DESCEND)
 599         destroy_fmt_list (f->down, 1);
 600       free (f);
 601     }
 602 }
 603
 604 /* Takes a hierarchically structured fmt_list F as constructed by
 605    fixed_parse_fortran(), and flattens it, adding the variable
 606    specifications to the linked list with head FIRST and tail
 607    LAST.  NAME_IDX is used to take values from the list of names
 608    in FX; it should initially point to a value of 0. */
 609 static int
 610 dump_fmt_list (struct fixed_parsing_state *fx, struct fmt_list *f,
 611                struct dls_var_spec **first, struct dls_var_spec **last,
 612                int *name_idx)
 613 {
 614   int i;
 615
 616   for (; f; f = f->next)
 617     if (f->f.type == FMT_X)
 618       fx->sc += f->count;
 619     else if (f->f.type == FMT_T)
 620       fx->sc = f->f.w;
 621     else if (f->f.type == FMT_NEWREC)
 622       {
 623         fx->recno += f->count;
 624         fx->sc = 1;
 625       }
 626     else
 627       for (i = 0; i < f->count; i++)
 628         if (f->f.type == FMT_DESCEND)
 629           {
 630             if (!dump_fmt_list (fx, f->down, first, last, name_idx))
 631               return 0;
 632           }
 633         else
 634           {
 635             struct dls_var_spec *spec;
 636             int width;
 637             struct variable *v;
 638
 639             if (formats[f->f.type].cat & FCAT_STRING)
 640               width = f->f.w;
 641             else
 642               width = 0;
 643             if (*name_idx >= fx->name_cnt)
 644               {
 645                 msg (SE, _("The number of format "
 646                            "specifications exceeds the given number of "
 647                            "variable names."));
 648                 return 0;
 649               }
 650
 651             v = dict_create_var (default_dict, fx->name[(*name_idx)++], width);
 652             if (!v)
 653               {
 654                 msg (SE, _("%s is a duplicate variable name."), fx->name[i]);
 655                 return 0;
 656               }
 657
 658             if (!case_source_is_complex (vfm_source))
 659               v->init = 0;
 660
 661             spec = xmalloc (sizeof *spec);
 662             spec->v = v;
 663             spec->input = f->f;
 664             spec->fv = v->fv;
 665             spec->rec = fx->recno;
 666             spec->fc = fx->sc;
 667             spec->lc = fx->sc + f->f.w - 1;
 668             append_var_spec (first, last, spec);
 669
 670             convert_fmt_ItoO (&spec->input, &v->print);
 671             v->write = v->print;
 672
 673             fx->sc += f->f.w;
 674           }
 675   return 1;
 676 }
 677
 678 /* Recursively parses a FORTRAN-like format specification into
 679    the linked list with head FIRST and tail TAIL.  LEVEL is the
 680    level of recursion, starting from 0.  Returns the parsed
 681    specification if successful, or a null pointer on failure.  */
 682 static struct fmt_list *
 683 fixed_parse_fortran_internal (struct fixed_parsing_state *fx,
 684                               struct dls_var_spec **first,
 685                               struct dls_var_spec **last)
 686 {
 687   struct fmt_list *head = NULL;
 688   struct fmt_list *tail = NULL;
 689
 690   lex_force_match ('(');
 691   while (token != ')')
 692     {
 693       /* New fmt_list. */
 694       struct fmt_list *new = xmalloc (sizeof *new);
 695       new->next = NULL;
 696
 697       /* Append new to list. */
 698       if (head != NULL)
 699         tail->next = new;
 700       else
 701         head = new;
 702       tail = new;
 703
 704       /* Parse count. */
 705       if (lex_is_integer ())
 706         {
 707           new->count = lex_integer ();
 708           lex_get ();
 709         }
 710       else
 711         new->count = 1;
 712
 713       /* Parse format specifier. */
 714       if (token == '(')
 715         {
 716           new->f.type = FMT_DESCEND;
 717           new->down = fixed_parse_fortran_internal (fx, first, last);
 718           if (new->down == NULL)
 719             goto fail;
 720         }
 721       else if (lex_match ('/'))
 722         new->f.type = FMT_NEWREC;
 723       else if (!parse_format_specifier (&new->f, FMTP_ALLOW_XT)
 724                || !check_input_specifier (&new->f, 1))
 725         goto fail;
 726
 727       lex_match (',');
 728     }
 729   lex_force_match (')');
 730
 731   return head;
 732
 733 fail:
 734   destroy_fmt_list (head, 0);
 735
 736   return NULL;
 737 }
 738
 739 /* Parses a FORTRAN-like format specification into the linked
 740    list with head FIRST and tail LAST.  Returns nonzero if
 741    successful. */
 742 static int
 743 fixed_parse_fortran (struct fixed_parsing_state *fx,
 744                      struct dls_var_spec **first, struct dls_var_spec **last)
 745 {
 746   struct fmt_list *list;
 747   int name_idx;
 748
 749   list = fixed_parse_fortran_internal (fx, first, last);
 750   if (list == NULL)
 751     return 0;
 752
 753   name_idx = 0;
 754   dump_fmt_list (fx, list, first, last, &name_idx);
 755   destroy_fmt_list (list, 1);
 756   if (name_idx < fx->name_cnt)
 757     {
 758       msg (SE, _("There aren't enough format specifications "
 759                  "to match the number of variable names given."));
 760       return 0;
 761     }
 762
 763   return 1;
 764 }
 765
 766 /* Displays a table giving information on fixed-format variable
 767    parsing on DATA LIST. */
 768 /* FIXME: The `Columns' column should be divided into three columns,
 769    one for the starting column, one for the dash, one for the ending
 770    column; then right-justify the starting column and left-justify the
 771    ending column. */
 772 static void
 773 dump_fixed_table (const struct dls_var_spec *specs,
 774                   const struct file_handle *fh, int rec_cnt)
 775 {
 776   const struct dls_var_spec *spec;
 777   struct tab_table *t;
 778   int i;
 779
 780   for (i = 0, spec = specs; spec; spec = spec->next)
 781     i++;
 782   t = tab_create (4, i + 1, 0);
 783   tab_columns (t, TAB_COL_DOWN, 1);
 784   tab_headers (t, 0, 0, 1, 0);
 785   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 786   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
 787   tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
 788   tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 789   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, i);
 790   tab_hline (t, TAL_2, 0, 3, 1);
 791   tab_dim (t, tab_natural_dimensions);
 792
 793   for (i = 1, spec = specs; spec; spec = spec->next, i++)
 794     {
 795       tab_text (t, 0, i, TAB_LEFT, spec->v->name);
 796       tab_text (t, 1, i, TAT_PRINTF, "%d", spec->rec);
 797       tab_text (t, 2, i, TAT_PRINTF, "%3d-%3d",
 798                     spec->fc, spec->lc);
 799       tab_text (t, 3, i, TAB_LEFT | TAT_FIX,
 800                     fmt_to_string (&spec->input));
 801     }
 802
 803   if (fh != NULL)
 804     tab_title (t, 1, ngettext ("Reading %d record from file %s.",
 805                                "Reading %d records from file %s.", rec_cnt),
 806                rec_cnt, handle_get_filename (fh));
 807   else
 808     tab_title (t, 1, ngettext ("Reading %d record from the command file.",
 809                                "Reading %d records from the command file.",
 810                                rec_cnt),
 811                rec_cnt);
 812   tab_submit (t);
 813 }
 814 \f
 815 /* Free-format parsing. */
 816
 817 /* Parses variable specifications for DATA LIST FREE and adds
 818    them to the linked list with head FIRST and tail LAST.
 819    Returns nonzero only if successful. */
 820 static int
 821 parse_free (struct dls_var_spec **first, struct dls_var_spec **last)
 822 {
 823   lex_get ();
 824   while (token != '.')
 825     {
 826       struct fmt_spec input, output;
 827       char **name;
 828       int name_cnt;
 829       int width;
 830       int i;
 831
 832       if (!parse_DATA_LIST_vars (&name, &name_cnt, PV_NONE))
 833         return 0;
 834
 835       if (lex_match ('('))
 836         {
 837           if (!parse_format_specifier (&input, 0)
 838               || !check_input_specifier (&input, 1)
 839               || !lex_force_match (')'))
 840             {
 841               for (i = 0; i < name_cnt; i++)
 842                 free (name[i]);
 843               free (name);
 844               return 0;
 845             }
 846           convert_fmt_ItoO (&input, &output);
 847         }
 848       else
 849         {
 850           lex_match ('*');
 851           input = make_input_format (FMT_F, 8, 0);
 852           output = get_format ();
 853         }
 854
 855       if (input.type == FMT_A || input.type == FMT_AHEX)
 856         width = input.w;
 857       else
 858         width = 0;
 859       for (i = 0; i < name_cnt; i++)
 860         {
 861           struct dls_var_spec *spec;
 862           struct variable *v;
 863
 864           v = dict_create_var (default_dict, name[i], width);
 865
 866           if (!v)
 867             {
 868               msg (SE, _("%s is a duplicate variable name."), name[i]);
 869               return 0;
 870             }
 871           v->print = v->write = output;
 872
 873           if (!case_source_is_complex (vfm_source))
 874             v->init = 0;
 875
 876           spec = xmalloc (sizeof *spec);
 877           spec->input = input;
 878           spec->v = v;
 879           spec->fv = v->fv;
 880           str_copy_trunc (spec->name, sizeof spec->name, v->name);
 881           append_var_spec (first, last, spec);
 882         }
 883       for (i = 0; i < name_cnt; i++)
 884         free (name[i]);
 885       free (name);
 886     }
 887
 888   return lex_end_of_command () == CMD_SUCCESS;
 889 }
 890
 891 /* Displays a table giving information on free-format variable parsing
 892    on DATA LIST. */
 893 static void
 894 dump_free_table (const struct data_list_pgm *dls,
 895                  const struct file_handle *fh)
 896 {
 897   struct tab_table *t;
 898   int i;
 899
 900   {
 901     struct dls_var_spec *spec;
 902     for (i = 0, spec = dls->first; spec; spec = spec->next)
 903       i++;
 904   }
 905
 906   t = tab_create (2, i + 1, 0);
 907   tab_columns (t, TAB_COL_DOWN, 1);
 908   tab_headers (t, 0, 0, 1, 0);
 909   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 910   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 911   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 1, i);
 912   tab_hline (t, TAL_2, 0, 1, 1);
 913   tab_dim (t, tab_natural_dimensions);
 914
 915   {
 916     struct dls_var_spec *spec;
 917
 918     for (i = 1, spec = dls->first; spec; spec = spec->next, i++)
 919       {
 920         tab_text (t, 0, i, TAB_LEFT, spec->v->name);
 921         tab_text (t, 1, i, TAB_LEFT | TAT_FIX, fmt_to_string (&spec->input));
 922       }
 923   }
 924
 925   if (fh != NULL)
 926     tab_title (t, 1, _("Reading free-form data from file %s."),
 927                handle_get_filename (fh));
 928   else
 929     tab_title (t, 1, _("Reading free-form data from the command file."));
 930
 931   tab_submit (t);
 932 }
 933 \f
 934 /* Input procedure. */
 935
 936 /* Extracts a field from the current position in the current
 937    record.  Fields can be unquoted or quoted with single- or
 938    double-quote characters.  *FIELD is set to the field content.
 939    After parsing the field, sets the current position in the
 940    record to just past the field and any trailing delimiter.
 941    END_BLANK is used internally; it should be initialized by the
 942    caller to 0 and left alone afterward.  Returns 0 on failure or
 943    a 1-based column number indicating the beginning of the field
 944    on success. */
 945 static int
 946 cut_field (const struct data_list_pgm *dls, struct fixed_string *field,
 947            int *end_blank)
 948 {
 949   struct fixed_string line;
 950   char *cp;
 951   size_t column_start;
 952
 953   if (dfm_eof (dls->reader))
 954     return 0;
 955   if (dls->delim_cnt == 0)
 956     dfm_expand_tabs (dls->reader);
 957   dfm_get_record (dls->reader, &line);
 958
 959   cp = ls_c_str (&line);
 960   if (dls->delim_cnt == 0)
 961     {
 962       /* Skip leading whitespace. */
 963       while (cp < ls_end (&line) && isspace ((unsigned char) *cp))
 964         cp++;
 965       if (cp >= ls_end (&line))
 966         return 0;
 967
 968       /* Handle actual data, whether quoted or unquoted. */
 969       if (*cp == '\'' || *cp == '"')
 970         {
 971           int quote = *cp;
 972
 973           field->string = ++cp;
 974           while (cp < ls_end (&line) && *cp != quote)
 975             cp++;
 976           field->length = cp - field->string;
 977           if (cp < ls_end (&line))
 978             cp++;
 979           else
 980             msg (SW, _("Quoted string missing terminating `%c'."), quote);
 981         }
 982       else
 983         {
 984           field->string = cp;
 985           while (cp < ls_end (&line)
 986                  && !isspace ((unsigned char) *cp) && *cp != ',')
 987             cp++;
 988           field->length = cp - field->string;
 989         }
 990
 991       /* Skip trailing whitespace and a single comma if present. */
 992       while (cp < ls_end (&line) && isspace ((unsigned char) *cp))
 993         cp++;
 994       if (cp < ls_end (&line) && *cp == ',')
 995         cp++;
 996     }
 997   else
 998     {
 999       if (cp >= ls_end (&line))
1000         {
1001           int column = dfm_column_start (dls->reader);
1002                /* A blank line or a line that ends in \t has a
1003              trailing blank field. */
1004           if (column == 1 || (column > 1 && cp[-1] == '\t'))
1005             {
1006               if (*end_blank == 0)
1007                 {
1008                   *end_blank = 1;
1009                   field->string = ls_end (&line);
1010                   field->length = 0;
1011                   dfm_forward_record (dls->reader);
1012                   return column;
1013                 }
1014               else
1015                 {
1016                   *end_blank = 0;
1017                   return 0;
1018                 }
1019             }
1020           else
1021             return 0;
1022         }
1023       else
1024         {
1025           field->string = cp;
1026           while (cp < ls_end (&line)
1027                  && memchr (dls->delims, *cp, dls->delim_cnt) == NULL)
1028             cp++;
1029           field->length = cp - field->string;
1030           if (cp < ls_end (&line))
1031             cp++;
1032         }
1033     }
1034
1035   dfm_forward_columns (dls->reader, field->string - line.string);
1036   column_start = dfm_column_start (dls->reader);
1037
1038   dfm_forward_columns (dls->reader, cp - field->string);
1039
1040   return column_start;
1041 }
1042
1043 typedef int data_list_read_func (const struct data_list_pgm *, struct ccase *);
1044 static data_list_read_func read_from_data_list_fixed;
1045 static data_list_read_func read_from_data_list_free;
1046 static data_list_read_func read_from_data_list_list;
1047
1048 /* Returns the proper function to read the kind of DATA LIST
1049    data specified by DLS. */
1050 static data_list_read_func *
1051 get_data_list_read_func (const struct data_list_pgm *dls)
1052 {
1053   switch (dls->type)
1054     {
1055     case DLS_FIXED:
1056       return read_from_data_list_fixed;
1057
1058     case DLS_FREE:
1059       return read_from_data_list_free;
1060
1061     case DLS_LIST:
1062       return read_from_data_list_list;
1063
1064     default:
1065       assert (0);
1066       abort ();
1067     }
1068 }
1069
1070 /* Reads a case from the data file into C, parsing it according
1071    to fixed-format syntax rules in DLS.  Returns -1 on success,
1072    -2 at end of file. */
1073 static int
1074 read_from_data_list_fixed (const struct data_list_pgm *dls,
1075                            struct ccase *c)
1076 {
1077   struct dls_var_spec *var_spec = dls->first;
1078   int i;
1079
1080   if (dfm_eof (dls->reader))
1081     return -2;
1082   for (i = 1; i <= dls->rec_cnt; i++)
1083     {
1084       struct fixed_string line;
1085
1086       if (dfm_eof (dls->reader))
1087         {
1088           /* Note that this can't occur on the first record. */
1089           msg (SW, _("Partial case of %d of %d records discarded."),
1090                i - 1, dls->rec_cnt);
1091           return -2;
1092         }
1093       dfm_expand_tabs (dls->reader);
1094       dfm_get_record (dls->reader, &line);
1095
1096       for (; var_spec && i == var_spec->rec; var_spec = var_spec->next)
1097         {
1098           struct data_in di;
1099
1100           data_in_finite_line (&di, ls_c_str (&line), ls_length (&line),
1101                                var_spec->fc, var_spec->lc);
1102           di.v = case_data_rw (c, var_spec->fv);
1103           di.flags = DI_IMPLIED_DECIMALS;
1104           di.f1 = var_spec->fc;
1105           di.format = var_spec->input;
1106
1107           data_in (&di);
1108         }
1109
1110       dfm_forward_record (dls->reader);
1111     }
1112
1113   return -1;
1114 }
1115
1116 /* Reads a case from the data file into C, parsing it according
1117    to free-format syntax rules in DLS.  Returns -1 on success,
1118    -2 at end of file. */
1119 static int
1120 read_from_data_list_free (const struct data_list_pgm *dls,
1121                           struct ccase *c)
1122 {
1123   struct dls_var_spec *var_spec;
1124   int end_blank = 0;
1125
1126   for (var_spec = dls->first; var_spec; var_spec = var_spec->next)
1127     {
1128       struct fixed_string field;
1129       int column;
1130
1131       /* Cut out a field and read in a new record if necessary. */
1132       for (;;)
1133         {
1134           column = cut_field (dls, &field, &end_blank);
1135           if (column != 0)
1136             break;
1137
1138           if (!dfm_eof (dls->reader))
1139             dfm_forward_record (dls->reader);
1140           if (dfm_eof (dls->reader))
1141             {
1142               if (var_spec != dls->first)
1143                 msg (SW, _("Partial case discarded.  The first variable "
1144                            "missing was %s."), var_spec->name);
1145               return -2;
1146             }
1147         }
1148
1149       {
1150         struct data_in di;
1151
1152         di.s = ls_c_str (&field);
1153         di.e = ls_end (&field);
1154         di.v = case_data_rw (c, var_spec->fv);
1155         di.flags = 0;
1156         di.f1 = column;
1157         di.format = var_spec->input;
1158         data_in (&di);
1159       }
1160     }
1161   return -1;
1162 }
1163
1164 /* Reads a case from the data file and parses it according to
1165    list-format syntax rules.  Returns -1 on success, -2 at end of
1166    file. */
1167 static int
1168 read_from_data_list_list (const struct data_list_pgm *dls,
1169                           struct ccase *c)
1170 {
1171   struct dls_var_spec *var_spec;
1172   int end_blank = 0;
1173
1174   if (dfm_eof (dls->reader))
1175     return -2;
1176
1177   for (var_spec = dls->first; var_spec; var_spec = var_spec->next)
1178     {
1179       struct fixed_string field;
1180       int column;
1181
1182       /* Cut out a field and check for end-of-line. */
1183       column = cut_field (dls, &field, &end_blank);
1184       if (column == 0)
1185         {
1186           if (get_undefined ())
1187             msg (SW, _("Missing value(s) for all variables from %s onward.  "
1188                        "These will be filled with the system-missing value "
1189                        "or blanks, as appropriate."),
1190                  var_spec->name);
1191           for (; var_spec; var_spec = var_spec->next)
1192             {
1193               int width = get_format_var_width (&var_spec->input);
1194               if (width == 0)
1195                 case_data_rw (c, var_spec->fv)->f = SYSMIS;
1196               else
1197                 memset (case_data_rw (c, var_spec->fv)->s, ' ', width);
1198             }
1199           break;
1200         }
1201
1202       {
1203         struct data_in di;
1204
1205         di.s = ls_c_str (&field);
1206         di.e = ls_end (&field);
1207         di.v = case_data_rw (c, var_spec->fv);
1208         di.flags = 0;
1209         di.f1 = column;
1210         di.format = var_spec->input;
1211         data_in (&di);
1212       }
1213     }
1214
1215   dfm_forward_record (dls->reader);
1216   return -1;
1217 }
1218
1219 /* Destroys SPEC. */
1220 static void
1221 destroy_dls_var_spec (struct dls_var_spec *spec)
1222 {
1223   struct dls_var_spec *next;
1224
1225   while (spec != NULL)
1226     {
1227       next = spec->next;
1228       free (spec);
1229       spec = next;
1230     }
1231 }
1232
1233 /* Destroys DATA LIST transformation PGM. */
1234 static void
1235 data_list_trns_free (struct trns_header *pgm)
1236 {
1237   struct data_list_pgm *dls = (struct data_list_pgm *) pgm;
1238   free (dls->delims);
1239   destroy_dls_var_spec (dls->first);
1240   dfm_close_reader (dls->reader);
1241 }
1242
1243 /* Handle DATA LIST transformation T, parsing data into C. */
1244 static int
1245 data_list_trns_proc (struct trns_header *t, struct ccase *c,
1246                      int case_num UNUSED)
1247 {
1248   struct data_list_pgm *dls = (struct data_list_pgm *) t;
1249   data_list_read_func *read_func;
1250   int retval;
1251
1252   dfm_push (dls->reader);
1253
1254   read_func = get_data_list_read_func (dls);
1255   retval = read_func (dls, c);
1256
1257   /* Handle end of file. */
1258   if (retval == -2)
1259     {
1260       /* If we already encountered end of file then this is an
1261          error. */
1262       if (dls->eof == 1)
1263         {
1264           msg (SE, _("Attempt to read past end of file."));
1265           err_failure ();
1266           dfm_pop (dls->reader);
1267           return -2;
1268         }
1269
1270       /* Otherwise simply note it. */
1271       dls->eof = 1;
1272     }
1273   else
1274     dls->eof = 0;
1275
1276   /* If there was an END subcommand handle it. */
1277   if (dls->end != NULL)
1278     {
1279       if (retval == -2)
1280         {
1281           case_data_rw (c, dls->end->fv)->f = 1.0;
1282           retval = -1;
1283         }
1284       else
1285         case_data_rw (c, dls->end->fv)->f = 0.0;
1286     }
1287
1288   dfm_pop (dls->reader);
1289
1290   return retval;
1291 }
1292 \f
1293 /* Reads all the records from the data file and passes them to
1294    write_case(). */
1295 static void
1296 data_list_source_read (struct case_source *source,
1297                        struct ccase *c,
1298                        write_case_func *write_case, write_case_data wc_data)
1299 {
1300   struct data_list_pgm *dls = source->aux;
1301   data_list_read_func *read_func = get_data_list_read_func (dls);
1302
1303   dfm_push (dls->reader);
1304   while (read_func (dls, c) != -2)
1305     if (!write_case (wc_data))
1306       break;
1307   dfm_pop (dls->reader);
1308 }
1309
1310 /* Destroys the source's internal data. */
1311 static void
1312 data_list_source_destroy (struct case_source *source)
1313 {
1314   data_list_trns_free (source->aux);
1315   free (source->aux);
1316 }
1317
1318 const struct case_source_class data_list_source_class =
1319   {
1320     "DATA LIST",
1321     NULL,
1322     data_list_source_read,
1323     data_list_source_destroy,
1324   };
1325 \f
1326 /* REPEATING DATA. */
1327
1328 /* Represents a number or a variable. */
1329 struct rpd_num_or_var
1330   {
1331     int num;                    /* Value, or 0. */
1332     struct variable *var;       /* Variable, if number==0. */
1333   };
1334
1335 /* REPEATING DATA private data structure. */
1336 struct repeating_data_trns
1337   {
1338     struct trns_header h;
1339     struct dls_var_spec *first, *last;  /* Variable parsing specifications. */
1340     struct dfm_reader *reader;          /* Input file, never NULL. */
1341
1342     struct rpd_num_or_var starts_beg;   /* STARTS=, before the dash. */
1343     struct rpd_num_or_var starts_end;   /* STARTS=, after the dash. */
1344     struct rpd_num_or_var occurs;       /* OCCURS= subcommand. */
1345     struct rpd_num_or_var length;       /* LENGTH= subcommand. */
1346     struct rpd_num_or_var cont_beg;     /* CONTINUED=, before the dash. */
1347     struct rpd_num_or_var cont_end;     /* CONTINUED=, after the dash. */
1348
1349     /* ID subcommand. */
1350     int id_beg, id_end;                 /* Beginning & end columns. */
1351     struct variable *id_var;            /* DATA LIST variable. */
1352     struct fmt_spec id_spec;            /* Input format spec. */
1353     union value *id_value;              /* ID value. */
1354
1355     write_case_func *write_case;
1356     write_case_data wc_data;
1357   };
1358
1359 static trns_free_func repeating_data_trns_free;
1360 static int parse_num_or_var (struct rpd_num_or_var *, const char *);
1361 static int parse_repeating_data (struct dls_var_spec **,
1362                                  struct dls_var_spec **);
1363 static void find_variable_input_spec (struct variable *v,
1364                                       struct fmt_spec *spec);
1365
1366 /* Parses the REPEATING DATA command. */
1367 int
1368 cmd_repeating_data (void)
1369 {
1370   struct repeating_data_trns *rpd;
1371   int table = 1;                /* Print table? */
1372   bool saw_starts = false;      /* Saw STARTS subcommand? */
1373   bool saw_occurs = false;      /* Saw OCCURS subcommand? */
1374   bool saw_length = false;      /* Saw LENGTH subcommand? */
1375   bool saw_continued = false;   /* Saw CONTINUED subcommand? */
1376   bool saw_id = false;          /* Saw ID subcommand? */
1377   struct file_handle *const fh = default_handle;
1378
1379   assert (case_source_is_complex (vfm_source));
1380
1381   rpd = xmalloc (sizeof *rpd);
1382   rpd->reader = dfm_open_reader (default_handle);
1383   rpd->first = rpd->last = NULL;
1384   rpd->starts_beg.num = 0;
1385   rpd->starts_beg.var = NULL;
1386   rpd->starts_end = rpd->occurs = rpd->length = rpd->cont_beg
1387     = rpd->cont_end = rpd->starts_beg;
1388   rpd->id_beg = rpd->id_end = 0;
1389   rpd->id_var = NULL;
1390   rpd->id_value = NULL;
1391
1392   lex_match ('/');
1393
1394   for (;;)
1395     {
1396       if (lex_match_id ("FILE"))
1397         {
1398           struct file_handle *file;
1399           lex_match ('=');
1400           file = fh_parse ();
1401           if (file == NULL)
1402             goto error;
1403           if (file != fh)
1404             {
1405               msg (SE, _("REPEATING DATA must use the same file as its "
1406                          "corresponding DATA LIST or FILE TYPE."));
1407               goto error;
1408             }
1409         }
1410       else if (lex_match_id ("STARTS"))
1411         {
1412           lex_match ('=');
1413           if (saw_starts)
1414             {
1415               msg (SE, _("%s subcommand given multiple times."),"STARTS");
1416               goto error;
1417             }
1418           saw_starts = true;
1419
1420           if (!parse_num_or_var (&rpd->starts_beg, "STARTS beginning column"))
1421             goto error;
1422
1423           lex_negative_to_dash ();
1424           if (lex_match ('-'))
1425             {
1426               if (!parse_num_or_var (&rpd->starts_end, "STARTS ending column"))
1427                 goto error;
1428             } else {
1429               /* Otherwise, rpd->starts_end is uninitialized.  We
1430                  will initialize it later from the record length
1431                  of the file.  We can't do so now because the
1432                  file handle may not be specified yet. */
1433             }
1434
1435           if (rpd->starts_beg.num != 0 && rpd->starts_end.num != 0
1436               && rpd->starts_beg.num > rpd->starts_end.num)
1437             {
1438               msg (SE, _("STARTS beginning column (%d) exceeds "
1439                          "STARTS ending column (%d)."),
1440                    rpd->starts_beg.num, rpd->starts_end.num);
1441               goto error;
1442             }
1443         }
1444       else if (lex_match_id ("OCCURS"))
1445         {
1446           lex_match ('=');
1447           if (saw_occurs)
1448             {
1449               msg (SE, _("%s subcommand given multiple times."),"OCCURS");
1450               goto error;
1451             }
1452           saw_occurs |= 2;
1453
1454           if (!parse_num_or_var (&rpd->occurs, "OCCURS"))
1455             goto error;
1456         }
1457       else if (lex_match_id ("LENGTH"))
1458         {
1459           lex_match ('=');
1460           if (saw_length & 4)
1461             {
1462               msg (SE, _("%s subcommand given multiple times."),"LENGTH");
1463               goto error;
1464             }
1465           saw_length |= 4;
1466
1467           if (!parse_num_or_var (&rpd->length, "LENGTH"))
1468             goto error;
1469         }
1470       else if (lex_match_id ("CONTINUED"))
1471         {
1472           lex_match ('=');
1473           if (saw_continued & 8)
1474             {
1475               msg (SE, _("%s subcommand given multiple times."),"CONTINUED");
1476               goto error;
1477             }
1478           saw_continued |= 8;
1479
1480           if (!lex_match ('/'))
1481             {
1482               if (!parse_num_or_var (&rpd->cont_beg,
1483                                      "CONTINUED beginning column"))
1484                 goto error;
1485
1486               lex_negative_to_dash ();
1487               if (lex_match ('-')
1488                   && !parse_num_or_var (&rpd->cont_end,
1489                                         "CONTINUED ending column"))
1490                 goto error;
1491
1492               if (rpd->cont_beg.num != 0 && rpd->cont_end.num != 0
1493                   && rpd->cont_beg.num > rpd->cont_end.num)
1494                 {
1495                   msg (SE, _("CONTINUED beginning column (%d) exceeds "
1496                              "CONTINUED ending column (%d)."),
1497                        rpd->cont_beg.num, rpd->cont_end.num);
1498                   goto error;
1499                 }
1500             }
1501           else
1502             rpd->cont_beg.num = 1;
1503         }
1504       else if (lex_match_id ("ID"))
1505         {
1506           lex_match ('=');
1507           if (saw_id & 16)
1508             {
1509               msg (SE, _("%s subcommand given multiple times."),"ID");
1510               goto error;
1511             }
1512           saw_id |= 16;
1513
1514           if (!lex_force_int ())
1515             goto error;
1516           if (lex_integer () < 1)
1517             {
1518               msg (SE, _("ID beginning column (%ld) must be positive."),
1519                    lex_integer ());
1520               goto error;
1521             }
1522           rpd->id_beg = lex_integer ();
1523
1524           lex_get ();
1525           lex_negative_to_dash ();
1526
1527           if (lex_match ('-'))
1528             {
1529               if (!lex_force_int ())
1530                 goto error;
1531               if (lex_integer () < 1)
1532                 {
1533                   msg (SE, _("ID ending column (%ld) must be positive."),
1534                        lex_integer ());
1535                   goto error;
1536                 }
1537               if (lex_integer () < rpd->id_end)
1538                 {
1539                   msg (SE, _("ID ending column (%ld) cannot be less than "
1540                              "ID beginning column (%d)."),
1541                        lex_integer (), rpd->id_beg);
1542                   goto error;
1543                 }
1544
1545               rpd->id_end = lex_integer ();
1546               lex_get ();
1547             }
1548           else rpd->id_end = rpd->id_beg;
1549
1550           if (!lex_force_match ('='))
1551             goto error;
1552           rpd->id_var = parse_variable ();
1553           if (rpd->id_var == NULL)
1554             goto error;
1555
1556           find_variable_input_spec (rpd->id_var, &rpd->id_spec);
1557           rpd->id_value = xmalloc (sizeof *rpd->id_value * rpd->id_var->nv);
1558         }
1559       else if (lex_match_id ("TABLE"))
1560         table = 1;
1561       else if (lex_match_id ("NOTABLE"))
1562         table = 0;
1563       else if (lex_match_id ("DATA"))
1564         break;
1565       else
1566         {
1567           lex_error (NULL);
1568           goto error;
1569         }
1570
1571       if (!lex_force_match ('/'))
1572         goto error;
1573     }
1574
1575   /* Comes here when DATA specification encountered. */
1576   if (!saw_starts || !saw_occurs)
1577     {
1578       if (!saw_starts)
1579         msg (SE, _("Missing required specification STARTS."));
1580       if (!saw_occurs)
1581         msg (SE, _("Missing required specification OCCURS."));
1582       goto error;
1583     }
1584
1585   /* Enforce ID restriction. */
1586   if (saw_id && !saw_continued)
1587     {
1588       msg (SE, _("ID specified without CONTINUED."));
1589       goto error;
1590     }
1591
1592   /* Calculate and check starts_end, cont_end if necessary. */
1593   if (rpd->starts_end.num == 0 && rpd->starts_end.var == NULL)
1594     {
1595       rpd->starts_end.num = fh != NULL ? handle_get_record_width (fh) : 80;
1596       if (rpd->starts_beg.num != 0
1597           && rpd->starts_beg.num > rpd->starts_end.num)
1598         {
1599           msg (SE, _("STARTS beginning column (%d) exceeds "
1600                      "default STARTS ending column taken from file's "
1601                      "record width (%d)."),
1602                rpd->starts_beg.num, rpd->starts_end.num);
1603           goto error;
1604         }
1605     }
1606   if (rpd->cont_end.num == 0 && rpd->cont_end.var == NULL)
1607     {
1608       rpd->cont_end.num = fh != NULL ? handle_get_record_width (fh) : 80;
1609       if (rpd->cont_beg.num != 0
1610           && rpd->cont_beg.num > rpd->cont_end.num)
1611         {
1612           msg (SE, _("CONTINUED beginning column (%d) exceeds "
1613                      "default CONTINUED ending column taken from file's "
1614                      "record width (%d)."),
1615                rpd->cont_beg.num, rpd->cont_end.num);
1616           goto error;
1617         }
1618     }
1619
1620   lex_match ('=');
1621   if (!parse_repeating_data (&rpd->first, &rpd->last))
1622     goto error;
1623
1624   /* Calculate length if necessary. */
1625   if (!saw_length)
1626     {
1627       struct dls_var_spec *iter;
1628
1629       for (iter = rpd->first; iter; iter = iter->next)
1630         if (iter->lc > rpd->length.num)
1631           rpd->length.num = iter->lc;
1632       assert (rpd->length.num != 0);
1633     }
1634
1635   if (table)
1636     dump_fixed_table (rpd->first, fh, rpd->last->rec);
1637
1638   rpd->h.proc = repeating_data_trns_proc;
1639   rpd->h.free = repeating_data_trns_free;
1640   add_transformation (&rpd->h);
1641
1642   return lex_end_of_command ();
1643
1644  error:
1645   destroy_dls_var_spec (rpd->first);
1646   free (rpd->id_value);
1647   return CMD_FAILURE;
1648 }
1649
1650 /* Finds the input format specification for variable V and puts
1651    it in SPEC.  Because of the way that DATA LIST is structured,
1652    this is nontrivial. */
1653 static void
1654 find_variable_input_spec (struct variable *v, struct fmt_spec *spec)
1655 {
1656   int i;
1657
1658   for (i = 0; i < n_trns; i++)
1659     {
1660       struct data_list_pgm *pgm = (struct data_list_pgm *) t_trns[i];
1661
1662       if (pgm->h.proc == data_list_trns_proc)
1663         {
1664           struct dls_var_spec *iter;
1665
1666           for (iter = pgm->first; iter; iter = iter->next)
1667             if (iter->v == v)
1668               {
1669                 *spec = iter->input;
1670                 return;
1671               }
1672         }
1673     }
1674
1675   assert (0);
1676 }
1677
1678 /* Parses a number or a variable name from the syntax file and puts
1679    the results in VALUE.  Ensures that the number is at least 1; else
1680    emits an error based on MESSAGE.  Returns nonzero only if
1681    successful. */
1682 static int
1683 parse_num_or_var (struct rpd_num_or_var *value, const char *message)
1684 {
1685   if (token == T_ID)
1686     {
1687       value->num = 0;
1688       value->var = parse_variable ();
1689       if (value->var == NULL)
1690         return 0;
1691       if (value->var->type == ALPHA)
1692         {
1693           msg (SE, _("String variable not allowed here."));
1694           return 0;
1695         }
1696     }
1697   else if (lex_is_integer ())
1698     {
1699       value->num = lex_integer ();
1700
1701       if (value->num < 1)
1702         {
1703           msg (SE, _("%s (%d) must be at least 1."), message, value->num);
1704           return 0;
1705         }
1706
1707       lex_get ();
1708     } else {
1709       msg (SE, _("Variable or integer expected for %s."), message);
1710       return 0;
1711     }
1712   return 1;
1713 }
1714
1715 /* Parses data specifications for repeating data groups, adding
1716    them to the linked list with head FIRST and tail LAST.
1717    Returns nonzero only if successful.  */
1718 static int
1719 parse_repeating_data (struct dls_var_spec **first, struct dls_var_spec **last)
1720 {
1721   struct fixed_parsing_state fx;
1722   int i;
1723
1724   fx.recno = 0;
1725   fx.sc = 1;
1726
1727   while (token != '.')
1728     {
1729       if (!parse_DATA_LIST_vars (&fx.name, &fx.name_cnt, PV_NONE))
1730         return 0;
1731
1732       if (lex_is_number ())
1733         {
1734           if (!fixed_parse_compatible (&fx, first, last))
1735             goto fail;
1736         }
1737       else if (token == '(')
1738         {
1739           if (!fixed_parse_fortran (&fx, first, last))
1740             goto fail;
1741         }
1742       else
1743         {
1744           msg (SE, _("SPSS-like or FORTRAN-like format "
1745                      "specification expected after variable names."));
1746           goto fail;
1747         }
1748
1749       for (i = 0; i < fx.name_cnt; i++)
1750         free (fx.name[i]);
1751       free (fx.name);
1752     }
1753
1754   return 1;
1755
1756  fail:
1757   for (i = 0; i < fx.name_cnt; i++)
1758     free (fx.name[i]);
1759   free (fx.name);
1760   return 0;
1761 }
1762
1763 /* Obtains the real value for rpd_num_or_var N in case C and returns
1764    it.  The valid range is nonnegative numbers, but numbers outside
1765    this range can be returned and should be handled by the caller as
1766    invalid. */
1767 static int
1768 realize_value (struct rpd_num_or_var *n, struct ccase *c)
1769 {
1770   if (n->var != NULL)
1771     {
1772       double v = case_num (c, n->var->fv);
1773       return v != SYSMIS && v >= INT_MIN && v <= INT_MAX ? v : -1;
1774     }
1775   else
1776     return n->num;
1777 }
1778
1779 /* Parameter record passed to rpd_parse_record(). */
1780 struct rpd_parse_info
1781   {
1782     struct repeating_data_trns *trns;  /* REPEATING DATA transformation. */
1783     const char *line;   /* Line being parsed. */
1784     size_t len;         /* Line length. */
1785     int beg, end;       /* First and last column of first occurrence. */
1786     int ofs;            /* Column offset between repeated occurrences. */
1787     struct ccase *c;    /* Case to fill in. */
1788     int verify_id;      /* Zero to initialize ID, nonzero to verify it. */
1789     int max_occurs;     /* Max number of occurrences to parse. */
1790   };
1791
1792 /* Parses one record of repeated data and outputs corresponding
1793    cases.  Returns number of occurrences parsed up to the
1794    maximum specified in INFO. */
1795 static int
1796 rpd_parse_record (const struct rpd_parse_info *info)
1797 {
1798   struct repeating_data_trns *t = info->trns;
1799   int cur = info->beg;
1800   int occurrences;
1801
1802   /* Handle record ID values. */
1803   if (t->id_beg != 0)
1804     {
1805       union value id_temp[MAX_ELEMS_PER_VALUE];
1806
1807       /* Parse record ID into V. */
1808       {
1809         struct data_in di;
1810
1811         data_in_finite_line (&di, info->line, info->len, t->id_beg, t->id_end);
1812         di.v = info->verify_id ? id_temp : t->id_value;
1813         di.flags = 0;
1814         di.f1 = t->id_beg;
1815         di.format = t->id_spec;
1816
1817         if (!data_in (&di))
1818           return 0;
1819       }
1820
1821       if (info->verify_id
1822           && compare_values (id_temp, t->id_value, t->id_var->width) != 0)
1823         {
1824           char expected_str [MAX_FORMATTED_LEN + 1];
1825           char actual_str [MAX_FORMATTED_LEN + 1];
1826
1827           data_out (expected_str, &t->id_var->print, t->id_value);
1828           expected_str[t->id_var->print.w] = '\0';
1829
1830           data_out (actual_str, &t->id_var->print, id_temp);
1831           actual_str[t->id_var->print.w] = '\0';
1832
1833           tmsg (SE, RPD_ERR,
1834                 _("Encountered mismatched record ID \"%s\" expecting \"%s\"."),
1835                 actual_str, expected_str);
1836
1837           return 0;
1838         }
1839     }
1840
1841   /* Iterate over the set of expected occurrences and record each of
1842      them as a separate case.  FIXME: We need to execute any
1843      transformations that follow the current one. */
1844   {
1845     int warned = 0;
1846
1847     for (occurrences = 0; occurrences < info->max_occurs; )
1848       {
1849         if (cur + info->ofs > info->end + 1)
1850           break;
1851         occurrences++;
1852
1853         {
1854           struct dls_var_spec *var_spec = t->first;
1855
1856           for (; var_spec; var_spec = var_spec->next)
1857             {
1858               int fc = var_spec->fc - 1 + cur;
1859               int lc = var_spec->lc - 1 + cur;
1860
1861               if (fc > info->len && !warned && var_spec->input.type != FMT_A)
1862                 {
1863                   warned = 1;
1864
1865                   tmsg (SW, RPD_ERR,
1866                         _("Variable %s starting in column %d extends "
1867                           "beyond physical record length of %d."),
1868                         var_spec->v->name, fc, info->len);
1869                 }
1870
1871               {
1872                 struct data_in di;
1873
1874                 data_in_finite_line (&di, info->line, info->len, fc, lc);
1875                 di.v = case_data_rw (info->c, var_spec->fv);
1876                 di.flags = 0;
1877                 di.f1 = fc + 1;
1878                 di.format = var_spec->input;
1879
1880                 if (!data_in (&di))
1881                   return 0;
1882               }
1883             }
1884         }
1885
1886         cur += info->ofs;
1887
1888         if (!t->write_case (t->wc_data))
1889           return 0;
1890       }
1891   }
1892
1893   return occurrences;
1894 }
1895
1896 /* Reads one set of repetitions of the elements in the REPEATING
1897    DATA structure.  Returns -1 on success, -2 on end of file or
1898    on failure. */
1899 int
1900 repeating_data_trns_proc (struct trns_header *trns, struct ccase *c,
1901                           int case_num UNUSED)
1902 {
1903   struct repeating_data_trns *t = (struct repeating_data_trns *) trns;
1904
1905   struct fixed_string line;       /* Current record. */
1906
1907   int starts_beg;       /* Starting column. */
1908   int starts_end;       /* Ending column. */
1909   int occurs;           /* Number of repetitions. */
1910   int length;           /* Length of each occurrence. */
1911   int cont_beg;         /* Starting column for continuation lines. */
1912   int cont_end;         /* Ending column for continuation lines. */
1913
1914   int occurs_left;      /* Number of occurrences remaining. */
1915
1916   int code;             /* Return value from rpd_parse_record(). */
1917
1918   int skip_first_record = 0;
1919
1920   dfm_push (t->reader);
1921
1922   /* Read the current record. */
1923   dfm_reread_record (t->reader, 1);
1924   dfm_expand_tabs (t->reader);
1925   if (dfm_eof (t->reader))
1926     return -2;
1927   dfm_get_record (t->reader, &line);
1928   dfm_forward_record (t->reader);
1929
1930   /* Calculate occurs, length. */
1931   occurs_left = occurs = realize_value (&t->occurs, c);
1932   if (occurs <= 0)
1933     {
1934       tmsg (SE, RPD_ERR, _("Invalid value %d for OCCURS."), occurs);
1935       return -3;
1936     }
1937   starts_beg = realize_value (&t->starts_beg, c);
1938   if (starts_beg <= 0)
1939     {
1940       tmsg (SE, RPD_ERR, _("Beginning column for STARTS (%d) must be "
1941                            "at least 1."),
1942             starts_beg);
1943       return -3;
1944     }
1945   starts_end = realize_value (&t->starts_end, c);
1946   if (starts_end < starts_beg)
1947     {
1948       tmsg (SE, RPD_ERR, _("Ending column for STARTS (%d) is less than "
1949                            "beginning column (%d)."),
1950             starts_end, starts_beg);
1951       skip_first_record = 1;
1952     }
1953   length = realize_value (&t->length, c);
1954   if (length < 0)
1955     {
1956       tmsg (SE, RPD_ERR, _("Invalid value %d for LENGTH."), length);
1957       length = 1;
1958       occurs = occurs_left = 1;
1959     }
1960   cont_beg = realize_value (&t->cont_beg, c);
1961   if (cont_beg < 0)
1962     {
1963       tmsg (SE, RPD_ERR, _("Beginning column for CONTINUED (%d) must be "
1964                            "at least 1."),
1965             cont_beg);
1966       return -2;
1967     }
1968   cont_end = realize_value (&t->cont_end, c);
1969   if (cont_end < cont_beg)
1970     {
1971       tmsg (SE, RPD_ERR, _("Ending column for CONTINUED (%d) is less than "
1972                            "beginning column (%d)."),
1973             cont_end, cont_beg);
1974       return -2;
1975     }
1976
1977   /* Parse the first record. */
1978   if (!skip_first_record)
1979     {
1980       struct rpd_parse_info info;
1981       info.trns = t;
1982       info.line = ls_c_str (&line);
1983       info.len = ls_length (&line);
1984       info.beg = starts_beg;
1985       info.end = starts_end;
1986       info.ofs = length;
1987       info.c = c;
1988       info.verify_id = 0;
1989       info.max_occurs = occurs_left;
1990       code = rpd_parse_record (&info);
1991       if (!code)
1992         return -2;
1993       occurs_left -= code;
1994     }
1995   else if (cont_beg == 0)
1996     return -3;
1997
1998   /* Make sure, if some occurrences are left, that we have
1999      continuation records. */
2000   if (occurs_left > 0 && cont_beg == 0)
2001     {
2002       tmsg (SE, RPD_ERR,
2003             _("Number of repetitions specified on OCCURS (%d) "
2004               "exceed number of repetitions available in "
2005               "space on STARTS (%d), and CONTINUED not specified."),
2006             occurs, (starts_end - starts_beg + 1) / length);
2007       return -2;
2008     }
2009
2010   /* Go on to additional records. */
2011   while (occurs_left != 0)
2012     {
2013       struct rpd_parse_info info;
2014
2015       assert (occurs_left >= 0);
2016
2017       /* Read in another record. */
2018       if (dfm_eof (t->reader))
2019         {
2020           tmsg (SE, RPD_ERR,
2021                 _("Unexpected end of file with %d repetitions "
2022                   "remaining out of %d."),
2023                 occurs_left, occurs);
2024           return -2;
2025         }
2026       dfm_expand_tabs (t->reader);
2027       dfm_get_record (t->reader, &line);
2028       dfm_forward_record (t->reader);
2029
2030       /* Parse this record. */
2031       info.trns = t;
2032       info.line = ls_c_str (&line);
2033       info.len = ls_length (&line);
2034       info.beg = cont_beg;
2035       info.end = cont_end;
2036       info.ofs = length;
2037       info.c = c;
2038       info.verify_id = 1;
2039       info.max_occurs = occurs_left;
2040       code = rpd_parse_record (&info);;
2041       if (!code)
2042         return -2;
2043       occurs_left -= code;
2044     }
2045
2046   dfm_pop (t->reader);
2047
2048   /* FIXME: This is a kluge until we've implemented multiplexing of
2049      transformations. */
2050   return -3;
2051 }
2052
2053 /* Frees a REPEATING DATA transformation. */
2054 void
2055 repeating_data_trns_free (struct trns_header *rpd_)
2056 {
2057   struct repeating_data_trns *rpd = (struct repeating_data_trns *) rpd_;
2058
2059   destroy_dls_var_spec (rpd->first);
2060   dfm_close_reader (rpd->reader);
2061   free (rpd->id_value);
2062 }
2063
2064 /* Lets repeating_data_trns_proc() know how to write the cases
2065    that it composes.  Not elegant. */
2066 void
2067 repeating_data_set_write_case (struct trns_header *trns,
2068                                write_case_func *write_case,
2069                                write_case_data wc_data)
2070 {
2071   struct repeating_data_trns *t = (struct repeating_data_trns *) trns;
2072
2073   assert (trns->proc == repeating_data_trns_proc);
2074   t->write_case = write_case;
2075   t->wc_data = wc_data;
2076 }