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