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