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