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