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                      ? _("Reading %d record%s from file %s.")
 755                      : _("Reading %d record%s from the command file.")),
 756                dls.nrec, dls.nrec != 1 ? "s" : "", filename);
 757     }
 758   else
 759     {
 760       buf = local_alloc (strlen (_("Occurrence data specifications.")) + 1);
 761       strcpy (buf, _("Occurrence data specifications."));
 762     }
 763
 764   tab_title (t, 0, buf);
 765   tab_submit (t);
 766   fh_handle_name (NULL);
 767   local_free (buf);
 768 }
 769 \f
 770 /* Free-format parsing. */
 771
 772 static int
 773 parse_free (void)
 774 {
 775   struct dls_var_spec spec;
 776   struct fmt_spec in, out;
 777   char **name;
 778   int nname;
 779   int i;
 780   int type;
 781
 782   lex_get ();
 783   while (token != '.')
 784     {
 785       if (!parse_DATA_LIST_vars (&name, &nname, PV_NONE))
 786         return 0;
 787       if (lex_match ('('))
 788         {
 789           if (!parse_format_specifier (&in, 0) || !check_input_specifier (&in))
 790             goto fail;
 791           if (!lex_force_match (')'))
 792             goto fail;
 793           convert_fmt_ItoO (&in, &out);
 794         }
 795       else
 796         {
 797           lex_match ('*');
 798           in.type = FMT_F;
 799           in.w = 8;
 800           in.d = 0;
 801           out = set_format;
 802         }
 803
 804       spec.input = in;
 805       if (in.type == FMT_A || in.type == FMT_AHEX)
 806         type = ALPHA;
 807       else
 808         type = NUMERIC;
 809       for (i = 0; i < nname; i++)
 810         {
 811           struct variable *v;
 812
 813           spec.v = v = create_variable (&default_dict, name[i], type, in.w);
 814           if (!v)
 815             {
 816               msg (SE, _("%s is a duplicate variable name."), name[i]);
 817               return 0;
 818             }
 819
 820           v->print = v->write = out;
 821
 822           strcpy (spec.name, name[i]);
 823           spec.fv = v->fv;
 824           spec.type = type == NUMERIC ? 0 : v->width;
 825           append_var_spec (&spec);
 826         }
 827       for (i = 0; i < nname; i++)
 828         free (name[i]);
 829       free (name);
 830     }
 831
 832   if (token != '.')
 833     lex_error (_("expecting end of command"));
 834   return 1;
 835
 836 fail:
 837   for (i = 0; i < nname; i++)
 838     free (name[i]);
 839   free (name);
 840   return 0;
 841 }
 842
 843 /* Displays a table giving information on free-format variable parsing
 844    on DATA LIST. */
 845 static void
 846 dump_free_table (void)
 847 {
 848   struct tab_table *t;
 849   int i;
 850
 851   {
 852     struct dls_var_spec *spec;
 853     for (i = 0, spec = dls.spec; spec; spec = spec->next)
 854       i++;
 855   }
 856
 857   t = tab_create (2, i + 1, 0);
 858   tab_columns (t, TAB_COL_DOWN, 1);
 859   tab_headers (t, 0, 0, 1, 0);
 860   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 861   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 862   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 1, i);
 863   tab_hline (t, TAL_2, 0, 1, 1);
 864   tab_dim (t, tab_natural_dimensions);
 865
 866   {
 867     struct dls_var_spec *spec;
 868
 869     for (i = 1, spec = dls.spec; spec; spec = spec->next, i++)
 870       {
 871         tab_text (t, 0, i, TAB_LEFT, spec->v->name);
 872         tab_text (t, 1, i, TAB_LEFT | TAT_FIX, fmt_to_string (&spec->input));
 873       }
 874   }
 875
 876   {
 877     const char *filename;
 878
 879     filename = fh_handle_name (dls.handle);
 880     if (filename == NULL)
 881       filename = "";
 882     tab_title (t, 1,
 883                (dls.handle != inline_file
 884                 ? _("Reading free-form data from file %s.")
 885                 : _("Reading free-form data from the command file.")),
 886                filename);
 887   }
 888
 889   tab_submit (t);
 890   fh_handle_name (NULL);
 891 }
 892 \f
 893 /* Input procedure. */
 894
 895 /* Pointer to relevant parsing data.  Static just to avoid passing it
 896    around so much. */
 897 static struct data_list_pgm *dlsp;
 898
 899 /* Extracts a field from the current position in the current record.
 900    Fields can be unquoted or quoted with single- or double-quote
 901    characters.  *RET_LEN is set to the field length, *RET_CP is set to
 902    the field itself.  After parsing the field, sets the current
 903    position in the record to just past the field.  Returns 0 on
 904    failure or a 1-based column number indicating the beginning of the
 905    field on success. */
 906 static int
 907 cut_field (char **ret_cp, int *ret_len)
 908 {
 909   char *cp, *ep;
 910   int len;
 911
 912   cp = dfm_get_record (dlsp->handle, &len);
 913   if (!cp)
 914     return 0;
 915
 916   ep = cp + len;
 917
 918   /* Skip leading whitespace and commas. */
 919   while ((isspace ((unsigned char) *cp) || *cp == ',') && cp < ep)
 920     cp++;
 921   if (cp >= ep)
 922     return 0;
 923
 924   /* Three types of fields: quoted with ', quoted with ", unquoted. */
 925   if (*cp == '\'' || *cp == '"')
 926     {
 927       int quote = *cp;
 928
 929       *ret_cp = ++cp;
 930       while (cp < ep && *cp != quote)
 931         cp++;
 932       *ret_len = cp - *ret_cp;
 933       if (cp < ep)
 934         cp++;
 935       else
 936         msg (SW, _("Scope of string exceeds line."));
 937     }
 938   else
 939     {
 940       *ret_cp = cp;
 941       while (cp < ep && !isspace ((unsigned char) *cp) && *cp != ',')
 942         cp++;
 943       *ret_len = cp - *ret_cp;
 944     }
 945
 946   {
 947     int beginning_column;
 948
 949     dfm_set_record (dlsp->handle, *ret_cp);
 950     beginning_column = dfm_get_cur_col (dlsp->handle) + 1;
 951
 952     dfm_set_record (dlsp->handle, cp);
 953
 954     return beginning_column;
 955   }
 956 }
 957
 958 static int read_from_data_list_fixed (void);
 959 static int read_from_data_list_free (void);
 960 static int read_from_data_list_list (void);
 961 static int do_reading (int flag);
 962
 963 /* FLAG==0: reads any number of cases into temp_case and calls
 964    write_case() for each one, returns garbage.  FLAG!=0: reads one
 965    case into temp_case and returns -2 on eof, -1 otherwise.
 966    Uses dlsp as the relevant parsing description. */
 967 static int
 968 do_reading (int flag)
 969 {
 970   int (*func) (void);
 971
 972   int code;
 973
 974   dfm_push (dlsp->handle);
 975
 976   switch (dlsp->type)
 977     {
 978     case DLS_FIXED:
 979       func = read_from_data_list_fixed;
 980       break;
 981     case DLS_FREE:
 982       func = read_from_data_list_free;
 983       break;
 984     case DLS_LIST:
 985       func = read_from_data_list_list;
 986       break;
 987     default:
 988       assert (0);
 989     }
 990   if (flag)
 991     {
 992       code = func ();
 993       if (code == -2)
 994         {
 995           if (dlsp->eof == 1)
 996             {
 997               msg (SE, _("Attempt to read past end of file."));
 998               err_failure ();
 999               return -2;
1000             }
1001           dlsp->eof = 1;
1002         }
1003       else
1004         dlsp->eof = 0;
1005
1006       if (dlsp->end != NULL)
1007         {
1008           if (code == -2)
1009             {
1010               printf ("end of file, setting %s to 1\n", dlsp->end->name);
1011               temp_case->data[dlsp->end->fv].f = 1.0;
1012               code = -1;
1013             }
1014           else
1015             {
1016               printf ("not end of file, setting %s to 0\n", dlsp->end->name);
1017               temp_case->data[dlsp->end->fv].f = 0.0;
1018             }
1019         }
1020     }
1021   else
1022     {
1023       while (func () != -2)
1024         if (!write_case ())
1025           {
1026             debug_printf ((_("abort in write_case()\n")));
1027             break;
1028           }
1029       fh_close_handle (dlsp->handle);
1030     }
1031   dfm_pop (dlsp->handle);
1032
1033   return code;
1034 }
1035
1036 /* Reads a case from the data file and parses it according to
1037    fixed-format syntax rules. */
1038 static int
1039 read_from_data_list_fixed (void)
1040 {
1041   struct dls_var_spec *var_spec = dlsp->spec;
1042   int i;
1043
1044   if (!dfm_get_record (dlsp->handle, NULL))
1045     return -2;
1046   for (i = 1; i <= dlsp->nrec; i++)
1047     {
1048       int len;
1049       char *line = dfm_get_record (dlsp->handle, &len);
1050
1051       if (!line)
1052         {
1053           /* Note that this can't occur on the first record. */
1054           msg (SW, _("Partial case of %d of %d records discarded."),
1055                i - 1, dlsp->nrec);
1056           return -2;
1057         }
1058
1059       for (; var_spec && i == var_spec->rec; var_spec = var_spec->next)
1060         {
1061           struct data_in di;
1062
1063           data_in_finite_line (&di, line, len, var_spec->fc, var_spec->lc);
1064           di.v = &temp_case->data[var_spec->fv];
1065           di.flags = 0;
1066           di.f1 = var_spec->fc;
1067           di.format = var_spec->input;
1068
1069           data_in (&di);
1070         }
1071
1072       dfm_fwd_record (dlsp->handle);
1073     }
1074
1075   return -1;
1076 }
1077
1078 /* Reads a case from the data file and parses it according to
1079    free-format syntax rules. */
1080 static int
1081 read_from_data_list_free (void)
1082 {
1083   struct dls_var_spec *var_spec;
1084   char *field;
1085   int len;
1086
1087   for (var_spec = dlsp->spec; var_spec; var_spec = var_spec->next)
1088     {
1089       int column;
1090
1091       /* Cut out a field and read in a new record if necessary. */
1092       for (;;)
1093         {
1094           column = cut_field (&field, &len);
1095           if (column != 0)
1096             break;
1097
1098           if (dfm_get_record (dlsp->handle, NULL))
1099             dfm_fwd_record (dlsp->handle);
1100           if (!dfm_get_record (dlsp->handle, NULL))
1101             {
1102               if (var_spec != dlsp->spec)
1103                 msg (SW, _("Partial case discarded.  The first variable "
1104                      "missing was %s."), var_spec->name);
1105               return -2;
1106             }
1107         }
1108
1109       {
1110         struct data_in di;
1111
1112         di.s = field;
1113         di.e = field + len;
1114         di.v = &temp_case->data[var_spec->fv];
1115         di.flags = 0;
1116         di.f1 = column;
1117         di.format = var_spec->input;
1118         data_in (&di);
1119       }
1120     }
1121   return -1;
1122 }
1123
1124 /* Reads a case from the data file and parses it according to
1125    list-format syntax rules. */
1126 static int
1127 read_from_data_list_list (void)
1128 {
1129   struct dls_var_spec *var_spec;
1130   char *field;
1131   int len;
1132
1133   if (!dfm_get_record (dlsp->handle, NULL))
1134     return -2;
1135
1136   for (var_spec = dlsp->spec; var_spec; var_spec = var_spec->next)
1137     {
1138       /* Cut out a field and check for end-of-line. */
1139       int column = cut_field (&field, &len);
1140
1141       if (column == 0)
1142         {
1143           if (set_undefined)
1144             msg (SW, _("Missing value(s) for all variables from %s onward.  "
1145                  "These will be filled with the system-missing value "
1146                  "or blanks, as appropriate."),
1147                  var_spec->name);
1148           for (; var_spec; var_spec = var_spec->next)
1149             if (!var_spec->type)
1150               temp_case->data[var_spec->fv].f = SYSMIS;
1151             else
1152               memset (temp_case->data[var_spec->fv].s, ' ', var_spec->type);
1153           break;
1154         }
1155
1156       {
1157         struct data_in di;
1158
1159         di.s = field;
1160         di.e = field + len;
1161         di.v = &temp_case->data[var_spec->fv];
1162         di.flags = 0;
1163         di.f1 = column;
1164         di.format = var_spec->input;
1165         data_in (&di);
1166       }
1167     }
1168
1169   dfm_fwd_record (dlsp->handle);
1170   return -1;
1171 }
1172
1173 /* Destroys DATA LIST transformation or input program PGM. */
1174 static void
1175 destroy_dls (struct trns_header *pgm)
1176 {
1177   struct data_list_pgm *dls = (struct data_list_pgm *) pgm;
1178   struct dls_var_spec *iter, *next;
1179
1180   iter = dls->spec;
1181   while (iter)
1182     {
1183       next = iter->next;
1184       free (iter);
1185       iter = next;
1186     }
1187   fh_close_handle (dls->handle);
1188 }
1189
1190 /* Note that since this is exclusively an input program, C is
1191    guaranteed to be temp_case. */
1192 static int
1193 read_one_case (struct trns_header *t, struct ccase *c unused)
1194 {
1195   dlsp = (struct data_list_pgm *) t;
1196   return do_reading (1);
1197 }
1198 \f
1199 /* Reads all the records from the data file and passes them to
1200    write_case(). */
1201 static void
1202 data_list_source_read (void)
1203 {
1204   dlsp = &dls;
1205   do_reading (0);
1206 }
1207
1208 /* Destroys the source's internal data. */
1209 static void
1210 data_list_source_destroy_source (void)
1211 {
1212   destroy_dls ((struct trns_header *) & dls);
1213 }
1214
1215 struct case_stream data_list_source =
1216   {
1217     NULL,
1218     data_list_source_read,
1219     NULL,
1220     NULL,
1221     data_list_source_destroy_source,
1222     NULL,
1223     "DATA LIST",
1224   };
1225 \f
1226 /* REPEATING DATA. */
1227
1228 /* Represents a number or a variable. */
1229 struct rpd_num_or_var
1230   {
1231     int num;                    /* Value, or 0. */
1232     struct variable *var;       /* Variable, if number==0. */
1233   };
1234
1235 /* REPEATING DATA private data structure. */
1236 struct repeating_data_trns
1237   {
1238     struct trns_header h;
1239     struct dls_var_spec *spec;  /* Variable parsing specifications. */
1240     struct file_handle *handle; /* Input file, never NULL. */
1241     /* Do not reorder preceding fields. */
1242
1243     struct rpd_num_or_var starts_beg;   /* STARTS=, before the dash. */
1244     struct rpd_num_or_var starts_end;   /* STARTS=, after the dash. */
1245     struct rpd_num_or_var occurs;       /* OCCURS= subcommand. */
1246     struct rpd_num_or_var length;       /* LENGTH= subcommand. */
1247     struct rpd_num_or_var cont_beg;     /* CONTINUED=, before the dash. */
1248     struct rpd_num_or_var cont_end;     /* CONTINUED=, after the dash. */
1249     int id_beg, id_end;                 /* ID subcommand, beginning & end columns. */
1250     struct variable *id_var;            /* ID subcommand, DATA LIST variable. */
1251     struct fmt_spec id_spec;            /* ID subcommand, input format spec. */
1252   };
1253
1254 /* Information about the transformation being parsed. */
1255 static struct repeating_data_trns rpd;
1256
1257 static int read_one_set_of_repetitions (struct trns_header *, struct ccase *);
1258 static int parse_num_or_var (struct rpd_num_or_var *, const char *);
1259 static int parse_repeating_data (void);
1260 static void find_variable_input_spec (struct variable *v,
1261                                       struct fmt_spec *spec);
1262
1263 /* Parses the REPEATING DATA command. */
1264 int
1265 cmd_repeating_data (void)
1266 {
1267   /* 0=print no table, 1=print table.  (TABLE subcommand.)  */
1268   int table = 1;
1269
1270   /* Bits are set when a particular subcommand has been seen. */
1271   unsigned seen = 0;
1272
1273   lex_match_id ("REPEATING");
1274   lex_match_id ("DATA");
1275
1276   assert (vfm_source == &input_program_source
1277           || vfm_source == &file_type_source);
1278
1279   rpd.handle = default_handle;
1280   rpd.starts_beg.num = 0;
1281   rpd.starts_beg.var = NULL;
1282   rpd.starts_end = rpd.occurs = rpd.length = rpd.cont_beg
1283     = rpd.cont_end = rpd.starts_beg;
1284   rpd.id_beg = rpd.id_end = 0;
1285   rpd.id_var = NULL;
1286   rpd.spec = NULL;
1287   first = &rpd.spec;
1288   next = NULL;
1289
1290   lex_match ('/');
1291
1292   for (;;)
1293     {
1294       if (lex_match_id ("FILE"))
1295         {
1296           lex_match ('=');
1297           rpd.handle = fh_parse_file_handle ();
1298           if (!rpd.handle)
1299             return CMD_FAILURE;
1300           if (rpd.handle != default_handle)
1301             {
1302               msg (SE, _("REPEATING DATA must use the same file as its "
1303                          "corresponding DATA LIST or FILE TYPE."));
1304               return CMD_FAILURE;
1305             }
1306         }
1307       else if (lex_match_id ("STARTS"))
1308         {
1309           lex_match ('=');
1310           if (seen & 1)
1311             {
1312               msg (SE, _("STARTS subcommand given multiple times."));
1313               return CMD_FAILURE;
1314             }
1315           seen |= 1;
1316
1317           if (!parse_num_or_var (&rpd.starts_beg, "STARTS beginning column"))
1318             return CMD_FAILURE;
1319
1320           lex_negative_to_dash ();
1321           if (lex_match ('-'))
1322             {
1323               if (!parse_num_or_var (&rpd.starts_end, "STARTS ending column"))
1324                 return CMD_FAILURE;
1325             } else {
1326               /* Otherwise, rpd.starts_end is left uninitialized.
1327                  This is okay.  We will initialize it later from the
1328                  record length of the file.  We can't do this now
1329                  because we can't be sure that the user has specified
1330                  the file handle yet. */
1331             }
1332
1333           if (rpd.starts_beg.num != 0 && rpd.starts_end.num != 0
1334               && rpd.starts_beg.num > rpd.starts_end.num)
1335             {
1336               msg (SE, _("STARTS beginning column (%d) exceeds "
1337                          "STARTS ending column (%d)."),
1338                    rpd.starts_beg.num, rpd.starts_end.num);
1339               return CMD_FAILURE;
1340             }
1341         }
1342       else if (lex_match_id ("OCCURS"))
1343         {
1344           lex_match ('=');
1345           if (seen & 2)
1346             {
1347               msg (SE, _("OCCURS subcommand given multiple times."));
1348               return CMD_FAILURE;
1349             }
1350           seen |= 2;
1351
1352           if (!parse_num_or_var (&rpd.occurs, "OCCURS"))
1353             return CMD_FAILURE;
1354         }
1355       else if (lex_match_id ("LENGTH"))
1356         {
1357           lex_match ('=');
1358           if (seen & 4)
1359             {
1360               msg (SE, _("LENGTH subcommand given multiple times."));
1361               return CMD_FAILURE;
1362             }
1363           seen |= 4;
1364
1365           if (!parse_num_or_var (&rpd.length, "LENGTH"))
1366             return CMD_FAILURE;
1367         }
1368       else if (lex_match_id ("CONTINUED"))
1369         {
1370           lex_match ('=');
1371           if (seen & 8)
1372             {
1373               msg (SE, _("CONTINUED subcommand given multiple times."));
1374               return CMD_FAILURE;
1375             }
1376           seen |= 8;
1377
1378           if (!lex_match ('/'))
1379             {
1380               if (!parse_num_or_var (&rpd.cont_beg, "CONTINUED beginning column"))
1381                 return CMD_FAILURE;
1382
1383               lex_negative_to_dash ();
1384               if (lex_match ('-')
1385                   && !parse_num_or_var (&rpd.cont_end,
1386                                         "CONTINUED ending column"))
1387                 return CMD_FAILURE;
1388
1389               if (rpd.cont_beg.num != 0 && rpd.cont_end.num != 0
1390                   && rpd.cont_beg.num > rpd.cont_end.num)
1391                 {
1392                   msg (SE, _("CONTINUED beginning column (%d) exceeds "
1393                              "CONTINUED ending column (%d)."),
1394                        rpd.cont_beg.num, rpd.cont_end.num);
1395                   return CMD_FAILURE;
1396                 }
1397             }
1398           else
1399             rpd.cont_beg.num = 1;
1400         }
1401       else if (lex_match_id ("ID"))
1402         {
1403           lex_match ('=');
1404           if (seen & 16)
1405             {
1406               msg (SE, _("ID subcommand given multiple times."));
1407               return CMD_FAILURE;
1408             }
1409           seen |= 16;
1410
1411           if (!lex_force_int ())
1412             return CMD_FAILURE;
1413           if (lex_integer () < 1)
1414             {
1415               msg (SE, _("ID beginning column (%ld) must be positive."),
1416                    lex_integer ());
1417               return CMD_FAILURE;
1418             }
1419           rpd.id_beg = lex_integer ();
1420
1421           lex_get ();
1422           lex_negative_to_dash ();
1423
1424           if (lex_match ('-'))
1425             {
1426               if (!lex_force_int ())
1427                 return CMD_FAILURE;
1428               if (lex_integer () < 1)
1429                 {
1430                   msg (SE, _("ID ending column (%ld) must be positive."),
1431                        lex_integer ());
1432                   return CMD_FAILURE;
1433                 }
1434               if (lex_integer () < rpd.id_end)
1435                 {
1436                   msg (SE, _("ID ending column (%ld) cannot be less than "
1437                              "ID beginning column (%d)."),
1438                        lex_integer (), rpd.id_beg);
1439                   return CMD_FAILURE;
1440                 }
1441
1442               rpd.id_end = lex_integer ();
1443               lex_get ();
1444             }
1445           else rpd.id_end = rpd.id_beg;
1446
1447           if (!lex_force_match ('='))
1448             return CMD_FAILURE;
1449           rpd.id_var = parse_variable ();
1450           if (rpd.id_var == NULL)
1451             return CMD_FAILURE;
1452
1453           find_variable_input_spec (rpd.id_var, &rpd.id_spec);
1454         }
1455       else if (lex_match_id ("TABLE"))
1456         table = 1;
1457       else if (lex_match_id ("NOTABLE"))
1458         table = 0;
1459       else if (lex_match_id ("DATA"))
1460         break;
1461       else
1462         {
1463           lex_error (NULL);
1464           return CMD_FAILURE;
1465         }
1466
1467       if (!lex_force_match ('/'))
1468         return CMD_FAILURE;
1469     }
1470
1471   /* Comes here when DATA specification encountered. */
1472   if ((seen & (1 | 2)) != (1 | 2))
1473     {
1474       if ((seen & 1) == 0)
1475         msg (SE, _("Missing required specification STARTS."));
1476       if ((seen & 2) == 0)
1477         msg (SE, _("Missing required specification OCCURS."));
1478       return CMD_FAILURE;
1479     }
1480
1481   /* Enforce ID restriction. */
1482   if ((seen & 16) && !(seen & 8))
1483     {
1484       msg (SE, _("ID specified without CONTINUED."));
1485       return CMD_FAILURE;
1486     }
1487
1488   /* Calculate starts_end, cont_end if necessary. */
1489   if (rpd.starts_end.num == 0 && rpd.starts_end.var == NULL)
1490     rpd.starts_end.num = fh_record_width (rpd.handle);
1491   if (rpd.cont_end.num == 0 && rpd.starts_end.var == NULL)
1492     rpd.cont_end.num = fh_record_width (rpd.handle);
1493
1494   /* Calculate length if possible. */
1495   if ((seen & 4) == 0)
1496     {
1497       struct dls_var_spec *iter;
1498
1499       for (iter = rpd.spec; iter; iter = iter->next)
1500         {
1501           if (iter->lc > rpd.length.num)
1502             rpd.length.num = iter->lc;
1503         }
1504       assert (rpd.length.num != 0);
1505     }
1506
1507   lex_match ('=');
1508   if (!parse_repeating_data ())
1509     return CMD_FAILURE;
1510
1511   if (table)
1512     dump_fixed_table ();
1513
1514   {
1515     struct repeating_data_trns *new_trns;
1516
1517     rpd.h.proc = read_one_set_of_repetitions;
1518     rpd.h.free = destroy_dls;
1519
1520     new_trns = xmalloc (sizeof *new_trns);
1521     memcpy (new_trns, &rpd, sizeof *new_trns);
1522     add_transformation ((struct trns_header *) new_trns);
1523   }
1524
1525   return lex_end_of_command ();
1526 }
1527
1528 /* Because of the way that DATA LIST is structured, it's not trivial
1529    to determine what input format is associated with a given variable.
1530    This function finds the input format specification for variable V
1531    and puts it in SPEC. */
1532 static void
1533 find_variable_input_spec (struct variable *v, struct fmt_spec *spec)
1534 {
1535   int i;
1536
1537   for (i = 0; i < n_trns; i++)
1538     {
1539       struct data_list_pgm *pgm = (struct data_list_pgm *) t_trns[i];
1540
1541       if (pgm->h.proc == read_one_case)
1542         {
1543           struct dls_var_spec *iter;
1544
1545           for (iter = pgm->spec; iter; iter = iter->next)
1546             if (iter->v == v)
1547               {
1548                 *spec = iter->input;
1549                 return;
1550               }
1551         }
1552     }
1553
1554   assert (0);
1555 }
1556
1557 /* Parses a number or a variable name from the syntax file and puts
1558    the results in VALUE.  Ensures that the number is at least 1; else
1559    emits an error based on MESSAGE.  Returns nonzero only if
1560    successful. */
1561 static int
1562 parse_num_or_var (struct rpd_num_or_var *value, const char *message)
1563 {
1564   if (token == T_ID)
1565     {
1566       value->num = 0;
1567       value->var = parse_variable ();
1568       if (value->var == NULL)
1569         return 0;
1570       if (value->var->type == ALPHA)
1571         {
1572           msg (SE, _("String variable not allowed here."));
1573           return 0;
1574         }
1575     }
1576   else if (lex_integer_p ())
1577     {
1578       value->num = lex_integer ();
1579
1580       if (value->num < 1)
1581         {
1582           msg (SE, _("%s (%d) must be at least 1."), message, value->num);
1583           return 0;
1584         }
1585
1586       lex_get ();
1587     } else {
1588       msg (SE, _("Variable or integer expected for %s."), message);
1589       return 0;
1590     }
1591   return 1;
1592 }
1593
1594 /* Parses data specifications for repeating data groups.  Taken from
1595    parse_fixed().  Returns nonzero only if successful.  */
1596 static int
1597 parse_repeating_data (void)
1598 {
1599   int i;
1600
1601   fx.recno = 0;
1602   fx.sc = 1;
1603
1604   while (token != '.')
1605     {
1606       fx.spec.rec = fx.recno;
1607
1608       if (!parse_DATA_LIST_vars (&fx.name, &fx.nname, PV_NONE))
1609         return 0;
1610
1611       if (token == T_NUM)
1612         {
1613           if (!fixed_parse_compatible ())
1614             goto fail;
1615         }
1616       else if (token == '(')
1617         {
1618           fx.level = 0;
1619           fx.cname = 0;
1620           if (!fixed_parse_fortran ())
1621             goto fail;
1622         }
1623       else
1624         {
1625           msg (SE, _("SPSS-like or FORTRAN-like format "
1626                "specification expected after variable names."));
1627           goto fail;
1628         }
1629
1630       for (i = 0; i < fx.nname; i++)
1631         free (fx.name[i]);
1632       free (fx.name);
1633     }
1634   if (token != '.')
1635     {
1636       lex_error (_("expecting end of command"));
1637       return 0;
1638     }
1639
1640   return 1;
1641
1642 fail:
1643   for (i = 0; i < fx.nname; i++)
1644     free (fx.name[i]);
1645   free (fx.name);
1646   return 0;
1647 }
1648
1649 /* Obtains the real value for rpd_num_or_var N in case C and returns
1650    it.  The valid range is nonnegative numbers, but numbers outside
1651    this range can be returned and should be handled by the caller as
1652    invalid. */
1653 static int
1654 realize_value (struct rpd_num_or_var *n, struct ccase *c)
1655 {
1656   if (n->num > 0)
1657     return n->num;
1658
1659   assert (n->num == 0);
1660   if (n->var != NULL)
1661     {
1662       double v = c->data[n->var->fv].f;
1663
1664       if (v == SYSMIS || v <= INT_MIN || v >= INT_MAX)
1665         return -1;
1666       else
1667         return v;
1668     }
1669   else
1670     return 0;
1671 }
1672
1673 /* Parses one record of repeated data and outputs corresponding cases.
1674    Repeating data is present in line LINE having length LEN.
1675    Repeating data begins in column BEG and continues through column
1676    END inclusive (1-based columns); occurrences are offset OFS columns
1677    from each other.  C is the case that will be filled in; T is the
1678    REPEATING DATA transformation.  The record ID will be verified if
1679    COMPARE_ID is nonzero; if it is zero, then the record ID is
1680    initialized to the ID present in the case (assuming that ID
1681    location was specified by the user).  Returns number of occurrences
1682    parsed up to the specified maximum of MAX_OCCURS. */
1683 static int
1684 rpd_parse_record (int beg, int end, int ofs, struct ccase *c,
1685                   struct repeating_data_trns *t,
1686                   char *line, int len, int compare_id, int max_occurs)
1687 {
1688   int occurrences;
1689   int cur = beg;
1690
1691   /* Handle record ID values. */
1692   if (t->id_beg != 0)
1693     {
1694       static union value comparator;
1695       union value v;
1696
1697       {
1698         struct data_in di;
1699
1700         data_in_finite_line (&di, line, len, t->id_beg, t->id_end);
1701         di.v = &v;
1702         di.flags = 0;
1703         di.f1 = t->id_beg;
1704         di.format = t->id_spec;
1705
1706         if (!data_in (&di))
1707           return 0;
1708       }
1709
1710       if (compare_id == 0)
1711         comparator = v;
1712       else if ((t->id_var->type == NUMERIC && comparator.f != v.f)
1713                || (t->id_var->type == ALPHA
1714                    && strncmp (comparator.s, v.s, t->id_var->width)))
1715         {
1716           char comp_str [64];
1717           char v_str [64];
1718
1719           if (!data_out (comp_str, &t->id_var->print, &comparator))
1720             comp_str[0] = 0;
1721           if (!data_out (v_str, &t->id_var->print, &v))
1722             v_str[0] = 0;
1723
1724           comp_str[t->id_var->print.w] = v_str[t->id_var->print.w] = 0;
1725
1726           tmsg (SE, RPD_ERR,
1727                 _("Mismatched case ID (%s).  Expected value was %s."),
1728                 v_str, comp_str);
1729
1730           return 0;
1731         }
1732     }
1733
1734   /* Iterate over the set of expected occurrences and record each of
1735      them as a separate case.  FIXME: We need to execute any
1736      transformations that follow the current one. */
1737   {
1738     int warned = 0;
1739
1740     for (occurrences = 0; occurrences < max_occurs; )
1741       {
1742         if (cur + ofs > end + 1)
1743           break;
1744         occurrences++;
1745
1746         {
1747           struct dls_var_spec *var_spec = t->spec;
1748
1749           for (; var_spec; var_spec = var_spec->next)
1750             {
1751               int fc = var_spec->fc - 1 + cur;
1752               int lc = var_spec->lc - 1 + cur;
1753
1754               if (fc > len && !warned && var_spec->input.type != FMT_A)
1755                 {
1756                   warned = 1;
1757
1758                   tmsg (SW, RPD_ERR,
1759                         _("Variable %s startging in column %d extends "
1760                           "beyond physical record length of %d."),
1761                         var_spec->v->name, fc, len);
1762                 }
1763
1764               {
1765                 struct data_in di;
1766
1767                 data_in_finite_line (&di, line, len, fc, lc);
1768                 di.v = &c->data[var_spec->fv];
1769                 di.flags = 0;
1770                 di.f1 = fc + 1;
1771                 di.format = var_spec->input;
1772
1773                 if (!data_in (&di))
1774                   return 0;
1775               }
1776             }
1777         }
1778
1779         cur += ofs;
1780
1781         if (!write_case ())
1782           return 0;
1783       }
1784   }
1785
1786   return occurrences;
1787 }
1788
1789 /* Analogous to read_one_case; reads one set of repetitions of the
1790    elements in the REPEATING DATA structure.  Returns -1 on success,
1791    -2 on end of file or on failure. */
1792 static int
1793 read_one_set_of_repetitions (struct trns_header *trns, struct ccase *c)
1794 {
1795   dfm_push (dlsp->handle);
1796
1797   {
1798     struct repeating_data_trns *t = (struct repeating_data_trns *) trns;
1799
1800     char *line;         /* Current record. */
1801     int len;            /* Length of current record. */
1802
1803     int starts_beg;     /* Starting column. */
1804     int starts_end;     /* Ending column. */
1805     int occurs;         /* Number of repetitions. */
1806     int length;         /* Length of each occurrence. */
1807     int cont_beg;       /* Starting column for continuation lines. */
1808     int cont_end;       /* Ending column for continuation lines. */
1809
1810     int occurs_left;    /* Number of occurrences remaining. */
1811
1812     int code;           /* Return value from rpd_parse_record(). */
1813
1814     int skip_first_record = 0;
1815
1816     /* Read the current record. */
1817     dfm_bkwd_record (dlsp->handle, 1);
1818     line = dfm_get_record (dlsp->handle, &len);
1819     if (line == NULL)
1820       return -2;
1821     dfm_fwd_record (dlsp->handle);
1822
1823     /* Calculate occurs, length. */
1824     occurs_left = occurs = realize_value (&t->occurs, c);
1825     if (occurs <= 0)
1826       {
1827         tmsg (SE, RPD_ERR, _("Invalid value %d for OCCURS."), occurs);
1828         return -3;
1829       }
1830     starts_beg = realize_value (&t->starts_beg, c);
1831     if (starts_beg <= 0)
1832       {
1833         tmsg (SE, RPD_ERR, _("Beginning column for STARTS (%d) must be "
1834                              "at least 1."),
1835               starts_beg);
1836         return -3;
1837       }
1838     starts_end = realize_value (&t->starts_end, c);
1839     if (starts_end < starts_beg)
1840       {
1841         tmsg (SE, RPD_ERR, _("Ending column for STARTS (%d) is less than "
1842                              "beginning column (%d)."),
1843               starts_end, starts_beg);
1844         skip_first_record = 1;
1845       }
1846     length = realize_value (&t->length, c);
1847     if (length < 0)
1848       {
1849         tmsg (SE, RPD_ERR, _("Invalid value %d for LENGTH."), length);
1850         length = 1;
1851         occurs = occurs_left = 1;
1852       }
1853     cont_beg = realize_value (&t->cont_beg, c);
1854     if (cont_beg < 0)
1855       {
1856         tmsg (SE, RPD_ERR, _("Beginning column for CONTINUED (%d) must be "
1857                              "at least 1."),
1858               cont_beg);
1859         return -2;
1860       }
1861     cont_end = realize_value (&t->cont_end, c);
1862     if (cont_end < cont_beg)
1863       {
1864         tmsg (SE, RPD_ERR, _("Ending column for CONTINUED (%d) is less than "
1865                              "beginning column (%d)."),
1866               cont_end, cont_beg);
1867         return -2;
1868       }
1869
1870     /* Parse the first record. */
1871     if (!skip_first_record)
1872       {
1873         code = rpd_parse_record (starts_beg, starts_end, length, c, t, line,
1874                                  len, 0, occurs_left);
1875         if (!code)
1876           return -2;
1877       }
1878     else if (cont_beg == 0)
1879       return -3;
1880
1881     /* Make sure, if some occurrences are left, that we have
1882        continuation records. */
1883     occurs_left -= code;
1884     if (occurs_left != 0 && cont_beg == 0)
1885       {
1886         tmsg (SE, RPD_ERR,
1887               _("Number of repetitions specified on OCCURS (%d) "
1888                 "exceed number of repetitions available in "
1889                 "space on STARTS (%d), and CONTINUED not specified."),
1890               occurs, code);
1891         return -2;
1892       }
1893
1894     /* Go on to additional records. */
1895     while (occurs_left != 0)
1896       {
1897         assert (occurs_left >= 0);
1898
1899         /* Read in another record. */
1900         line = dfm_get_record (dlsp->handle, &len);
1901         if (line == NULL)
1902           {
1903             tmsg (SE, RPD_ERR,
1904                   _("Unexpected end of file with %d repetitions "
1905                     "remaining out of %d."),
1906                   occurs_left, occurs);
1907             return -2;
1908           }
1909         dfm_fwd_record (dlsp->handle);
1910
1911         /* Parse this record. */
1912         code = rpd_parse_record (cont_beg, cont_end, length, c, t, line,
1913                                  len, 1, occurs_left);
1914         if (!code)
1915           return -2;
1916         occurs_left -= code;
1917       }
1918   }
1919
1920   dfm_pop (dlsp->handle);
1921
1922   /* FIXME: This is a kluge until we've implemented multiplexing of
1923      transformations. */
1924   return -3;
1925 }