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