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