src/data-list.c

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