Revise.
[pspp] / src / recode.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., 51 Franklin Street, Fifth Floor, Boston, MA
18    02110-1301, USA. */
19
20 #include <config.h>
21 #include "error.h"
22 #include <ctype.h>
23 #include <math.h>
24 #include <stdlib.h>
25 #include "alloc.h"
26 #include "case.h"
27 #include "command.h"
28 #include "dictionary.h"
29 #include "error.h"
30 #include "lexer.h"
31 #include "magic.h"
32 #include "str.h"
33 #include "var.h"
34
35 #include "gettext.h"
36 #define _(msgid) gettext (msgid)
37 \f
38 /* Definitions. */
39
40 /* Type of source value for RECODE. */
41 enum
42   {
43     RCD_END,                    /* sentinel value */
44     RCD_USER,                   /* user-missing => one */
45     RCD_SINGLE,                 /* one => one */
46     RCD_HIGH,                   /* x > a => one */
47     RCD_LOW,                    /* x < b => one */
48     RCD_RANGE,                  /* b < x < a => one */
49     RCD_ELSE,                   /* any but SYSMIS => one */
50     RCD_CONVERT                 /* "123" => 123 */
51   };
52
53 /* Describes how to recode a single value or range of values into a
54    single value.  */
55 struct coding
56   {
57     int type;                   /* RCD_* */
58     union value f1, f2;         /* Describe value or range as src.  Long
59                                    strings are stored in `c'. */
60     union value t;              /* Describes value as dest. Long strings in `c'. */
61   };
62
63 /* Describes how to recode a single variable. */
64 struct rcd_var
65   {
66     struct rcd_var *next;
67
68     unsigned flags;             /* RCD_SRC_* | RCD_DEST_* | RCD_MISC_* */
69
70     struct variable *src;       /* Source variable. */
71     struct variable *dest;      /* Destination variable. */
72     char dest_name[LONG_NAME_LEN + 1];          /* Name of dest variable if we're creating it. */
73
74     int has_sysmis;             /* Do we recode for SYSMIS? */
75     union value sysmis;         /* Coding for SYSMIS (if src is numeric). */
76
77     struct coding *map;         /* Coding for other values. */
78     int nmap, mmap;             /* Length of map, max capacity of map. */
79   };
80
81 /* RECODE transformation. */
82 struct recode_trns
83   {
84     struct trns_header h;
85     struct rcd_var *codings;
86   };
87
88 /* What we're recoding from (`src'==`source'). */
89 #define RCD_SRC_ERROR           0000u   /* Bad value for src. */
90 #define RCD_SRC_NUMERIC         0001u   /* Src is numeric. */
91 #define RCD_SRC_STRING          0002u   /* Src is short string. */
92 #define RCD_SRC_MASK            0003u   /* AND mask to isolate src bits. */
93
94 /* What we're recoding to (`dest'==`destination'). */
95 #define RCD_DEST_ERROR          0000u   /* Bad value for dest. */
96 #define RCD_DEST_NUMERIC        0004u   /* Dest is numeric. */
97 #define RCD_DEST_STRING         0010u   /* Dest is short string. */
98 #define RCD_DEST_MASK           0014u   /* AND mask to isolate dest bits. */
99
100 /* Miscellaneous bits. */
101 #define RCD_MISC_CREATE         0020u   /* We create dest var (numeric only) */
102 #define RCD_MISC_DUPLICATE      0040u   /* This var_info has the same MAP
103                                            value as the previous var_info.
104                                            Prevents redundant free()ing. */
105 #define RCD_MISC_MISSING        0100u   /* Encountered MISSING or SYSMIS in
106                                            this input spec. */
107
108 static int parse_dest_spec (struct rcd_var * rcd, union value *v,
109                             size_t *max_dst_width);
110 static int parse_src_spec (struct rcd_var * rcd, int type, size_t max_src_width);
111 static trns_proc_func recode_trns_proc;
112 static trns_free_func recode_trns_free;
113 static double convert_to_double (const char *, int);
114 \f
115 /* Parser. */
116
117 /* Parses the RECODE transformation. */
118 int
119 cmd_recode (void)
120 {
121   int i;
122
123   /* Transformation that we're constructing. */
124   struct rcd_var *rcd;
125
126   /* Type of the src variables. */
127   int type;
128
129   /* Length of longest src string. */
130   size_t max_src_width;
131
132   /* Length of longest dest string. */
133   size_t max_dst_width;
134
135   /* For stepping through, constructing the linked list of
136      recodings. */
137   struct rcd_var *iter;
138
139   /* The real transformation, just a wrapper for a list of
140      rcd_var's. */
141   struct recode_trns *trns;
142
143   /* First transformation in the list.  rcd is in this list. */
144   struct rcd_var *head;
145
146   /* Variables in the current part of the recoding. */
147   struct variable **v;
148   int nv;
149
150   /* Parses each specification between slashes. */
151   head = rcd = xmalloc (sizeof *rcd);
152   v = NULL;
153   for (;;)
154     {
155       /* Whether we've already encountered a specification for SYSMIS. */
156       int had_sysmis = 0;
157
158       /* Initialize this rcd_var to ensure proper cleanup. */
159       rcd->next = NULL;
160       rcd->map = NULL;
161       rcd->nmap = rcd->mmap = 0;
162       rcd->has_sysmis = 0;
163       rcd->sysmis.f = 0;
164
165       /* Parse variable names. */
166       if (!parse_variables (default_dict, &v, &nv, PV_SAME_TYPE))
167         goto lossage;
168
169       /* Ensure all variables are same type; find length of longest
170          source variable. */
171       type = v[0]->type;
172       max_src_width = v[0]->width;
173
174       if (type == ALPHA)
175         for (i = 0; i < nv; i++)
176           if (v[i]->width > (int) max_src_width)
177             max_src_width = v[i]->width;
178
179       /* Set up flags. */
180       rcd->flags = 0;
181       if (type == NUMERIC)
182         rcd->flags |= RCD_SRC_NUMERIC;
183       else
184         rcd->flags |= RCD_SRC_STRING;
185
186       /* Parse each coding in parentheses. */
187       max_dst_width = 0;
188       if (!lex_force_match ('('))
189         goto lossage;
190       for (;;) 
191         {
192           /* Get the input value (before the `='). */
193           int mark = rcd->nmap;
194           int code = parse_src_spec (rcd, type, max_src_width);
195           if (!code)
196             goto lossage;
197
198           /* ELSE is the same as any other input spec except that it
199              precludes later sysmis specifications. */
200           if (code == 3)
201             {
202               had_sysmis = 1;
203               code = 1;
204             }
205
206           /* If keyword CONVERT was specified, there is no output
207              specification.  */
208           if (code == 1)
209             {
210               union value output;
211
212               /* Get the output value (after the `='). */
213               lex_get ();       /* Skip `='. */
214               if (!parse_dest_spec (rcd, &output, &max_dst_width))
215                 goto lossage;
216
217               /* Set the value for SYSMIS if requested and if we don't
218                  already have one. */
219               if ((rcd->flags & RCD_MISC_MISSING) && !had_sysmis)
220                 {
221                   rcd->has_sysmis = 1;
222                   if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
223                     rcd->sysmis.f = output.f;
224                   else
225                     rcd->sysmis.c = xstrdup (output.c);
226                   had_sysmis = 1;
227
228                   rcd->flags &= ~RCD_MISC_MISSING;
229                 }
230
231               /* Since there may be multiple input values for a single
232                  output, the output value need to propagated among all
233                  of them. */
234               if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
235                 for (i = mark; i < rcd->nmap; i++)
236                   rcd->map[i].t.f = output.f;
237               else
238                 {
239                   for (i = mark; i < rcd->nmap; i++)
240                     rcd->map[i].t.c = (output.c?xstrdup (output.c):NULL);
241                   free (output.c);
242                 }
243             }
244           lex_get ();           /* Skip `)'. */
245           if (!lex_match ('('))
246             break;
247         }
248
249       /* Append sentinel value. */
250       rcd->map[rcd->nmap++].type = RCD_END;
251
252       /* Since multiple variables may use the same recodings, it is
253          necessary to propogate the codings to all of them. */
254       rcd->src = v[0];
255       rcd->dest = v[0];
256       rcd->dest_name[0] = 0;
257       iter = rcd;
258       for (i = 1; i < nv; i++)
259         {
260           iter = iter->next = xmalloc (sizeof *iter);
261           iter->next = NULL;
262           iter->flags = rcd->flags | RCD_MISC_DUPLICATE;
263           iter->src = v[i];
264           iter->dest = v[i];
265           iter->dest_name[0] = 0;
266           iter->has_sysmis = rcd->has_sysmis;
267           iter->sysmis = rcd->sysmis;
268           iter->map = rcd->map;
269         }
270
271       if (lex_match_id ("INTO"))
272         {
273           char **names;
274           int nnames;
275
276           int success = 0;
277
278           if (!parse_mixed_vars (&names, &nnames, PV_NONE))
279             goto lossage;
280
281           if (nnames != nv)
282             {
283               for (i = 0; i < nnames; i++)
284                 free (names[i]);
285               free (names);
286               msg (SE, _("%d variable(s) cannot be recoded into "
287                          "%d variable(s).  Specify the same number "
288                          "of variables as input and output variables."),
289                    nv, nnames);
290               goto lossage;
291             }
292
293           if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_STRING)
294             for (i = 0, iter = rcd; i < nv; i++, iter = iter->next)
295               {
296                 struct variable *v = dict_lookup_var (default_dict, names[i]);
297
298                 if (!v)
299                   {
300                     msg (SE, _("There is no string variable named "
301                          "%s.  (All string variables specified "
302                          "on INTO must already exist.  Use the "
303                          "STRING command to create a string "
304                          "variable.)"), names[i]);
305                     goto INTO_fail;
306                   }
307                 if (v->type != ALPHA)
308                   {
309                     msg (SE, _("Type mismatch between input and output "
310                          "variables.  Output variable %s is not "
311                          "a string variable, but all the input "
312                          "variables are string variables."), v->name);
313                     goto INTO_fail;
314                   }
315                 if (v->width > (int) max_dst_width)
316                   max_dst_width = v->width;
317                 iter->dest = v;
318               }
319           else
320             for (i = 0, iter = rcd; i < nv; i++, iter = iter->next)
321               {
322                 struct variable *v = dict_lookup_var (default_dict, names[i]);
323
324                 if (v)
325                   {
326                     if (v->type != NUMERIC)
327                       {
328                         msg (SE, _("Type mismatch after INTO: %s "
329                                    "is not a numeric variable."), v->name);
330                         goto INTO_fail;
331                       }
332                     else
333                       iter->dest = v;
334                   }
335                 else
336                   strcpy (iter->dest_name, names[i]);
337               }
338           success = 1;
339
340           /* Note that regardless of whether we succeed or fail,
341              flow-of-control comes here.  `success' is the important
342              factor.  Ah, if C had garbage collection...  */
343         INTO_fail:
344           for (i = 0; i < nnames; i++)
345             free (names[i]);
346           free (names);
347           if (!success)
348             goto lossage;
349         }
350       else
351         {
352           if (max_src_width > max_dst_width)
353             max_dst_width = max_src_width;
354
355           if ((rcd->flags & RCD_SRC_MASK) == RCD_SRC_NUMERIC
356               && (rcd->flags & RCD_DEST_MASK) != RCD_DEST_NUMERIC)
357             {
358               msg (SE, _("INTO must be used when the input values are "
359                          "numeric and output values are string."));
360               goto lossage;
361             }
362           
363           if ((rcd->flags & RCD_SRC_MASK) != RCD_SRC_NUMERIC
364               && (rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
365             {
366               msg (SE, _("INTO must be used when the input values are "
367                          "string and output values are numeric."));
368               goto lossage;
369             }
370         }
371
372       if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_STRING)
373         {
374           struct coding *cp;
375
376           for (cp = rcd->map; cp->type != RCD_END; cp++)
377             if (cp->t.c)
378               {
379                 if (strlen (cp->t.c) < max_dst_width)
380                   {
381                     /* The NULL is only really necessary for the
382                        debugging code. */
383                     char *repl = xmalloc (max_dst_width + 1);
384                     str_copy_rpad (repl, max_dst_width + 1, cp->t.c);
385                     free (cp->t.c);
386                     cp->t.c = repl;
387                   }
388                 else
389                   /* The strings are guaranteed to be in order of
390                      nondecreasing length. */
391                   break;
392               }
393           
394         }
395
396       free (v);
397       v = NULL;
398
399       if (!lex_match ('/'))
400         break;
401       while (rcd->next)
402         rcd = rcd->next;
403       rcd = rcd->next = xmalloc (sizeof *rcd);
404     }
405
406   if (token != '.')
407     {
408       lex_error (_("expecting end of command"));
409       goto lossage;
410     }
411
412   for (rcd = head; rcd; rcd = rcd->next)
413     if (rcd->dest_name[0])
414       {
415         rcd->dest = dict_create_var (default_dict, rcd->dest_name, 0);
416         if (!rcd->dest)
417           {
418             /* FIXME: This can fail if a destname is duplicated.
419                We could give an error at parse time but I don't
420                care enough. */
421             rcd->dest = dict_lookup_var_assert (default_dict, rcd->dest_name);
422           }
423       }
424
425   trns = xmalloc (sizeof *trns);
426   trns->h.proc = recode_trns_proc;
427   trns->h.free = recode_trns_free;
428   trns->codings = head;
429   add_transformation ((struct trns_header *) trns);
430
431   return CMD_SUCCESS;
432
433  lossage:
434   free (v);
435   {
436     struct recode_trns t;
437
438     t.codings = head;
439     recode_trns_free ((struct trns_header *) &t);
440     return CMD_FAILURE;
441   }
442 }
443
444 static int
445 parse_dest_spec (struct rcd_var * rcd, union value * v, size_t *max_dst_width)
446 {
447   int flags;
448
449   v->c = NULL;
450
451   if (lex_is_number ())
452     {
453       v->f = tokval;
454       lex_get ();
455       flags = RCD_DEST_NUMERIC;
456     }
457   else if (lex_match_id ("SYSMIS"))
458     {
459       v->f = SYSMIS;
460       flags = RCD_DEST_NUMERIC;
461     }
462   else if (token == T_STRING)
463     {
464       size_t max = *max_dst_width;
465       size_t toklen = ds_length (&tokstr);
466       if (toklen > max)
467         max = toklen;
468       v->c = xmalloc (max + 1);
469       str_copy_rpad (v->c, max + 1, ds_c_str (&tokstr));
470       flags = RCD_DEST_STRING;
471       *max_dst_width = max;
472       lex_get ();
473     }
474   else if (lex_match_id ("COPY"))
475     {
476       if ((rcd->flags & RCD_SRC_MASK) == RCD_SRC_NUMERIC)
477         {
478           flags = RCD_DEST_NUMERIC;
479           v->f = -SYSMIS;
480         }
481       else
482         {
483           flags = RCD_DEST_STRING;
484           v->c = NULL;
485         }
486     }
487   else 
488     {
489       lex_error (_("expecting output value"));
490       return 0;
491     }
492
493   if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_ERROR)
494     rcd->flags |= flags;
495 #if 0
496   else if (((rcd->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC
497             && flags != RCD_DEST_NUMERIC)
498            || ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_STRING
499                && flags != RCD_DEST_STRING))
500 #endif
501     else if ((rcd->flags & RCD_DEST_MASK) ^ flags)
502       {
503         msg (SE, _("Inconsistent output types.  The output values "
504                    "must be all numeric or all string."));
505         return 0;
506       }
507
508   return 1;
509 }
510
511 /* Reads a set of source specifications and returns one of the
512    following values: 0 on failure; 1 for normal success; 2 for success
513    but with CONVERT as the keyword; 3 for success but with ELSE as the
514    keyword. */
515 static int
516 parse_src_spec (struct rcd_var * rcd, int type, size_t max_src_width)
517 {
518   struct coding *c;
519
520   for (;;)
521     {
522       if (rcd->nmap >= rcd->mmap - 1)
523         {
524           rcd->mmap += 16;
525           rcd->map = xrealloc (rcd->map, rcd->mmap * sizeof *rcd->map);
526         }
527
528       c = &rcd->map[rcd->nmap];
529       c->f1.c = c->f2.c = NULL;
530       if (lex_match_id ("ELSE"))
531         {
532           c->type = RCD_ELSE;
533           rcd->nmap++;
534           return 3;
535         }
536       else if (type == NUMERIC)
537         {
538           if (token == T_ID)
539             {
540               if (lex_match_id ("LO") || lex_match_id ("LOWEST"))
541                 {
542                   if (!lex_force_match_id ("THRU"))
543                     return 0;
544                   if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
545                     c->type = RCD_ELSE;
546                   else if (lex_is_number ())
547                     {
548                       c->type = RCD_LOW;
549                       c->f1.f = tokval;
550                       lex_get ();
551                     }
552                   else
553                     {
554                       lex_error (_("following LO THRU"));
555                       return 0;
556                     }
557                 }
558               else if (lex_match_id ("MISSING"))
559                 {
560                   c->type = RCD_USER;
561                   rcd->flags |= RCD_MISC_MISSING;
562                 }
563               else if (lex_match_id ("SYSMIS"))
564                 {
565                   c->type = RCD_END;
566                   rcd->flags |= RCD_MISC_MISSING;
567                 }
568               else
569                 {
570                   lex_error (_("in source value"));
571                   return 0;
572                 }
573             }
574           else if (lex_is_number ())
575             {
576               c->f1.f = tokval;
577               lex_get ();
578               if (lex_match_id ("THRU"))
579                 {
580                   if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
581                     c->type = RCD_HIGH;
582                   else if (lex_is_number ())
583                     {
584                       c->type = RCD_RANGE;
585                       c->f2.f = tokval;
586                       lex_get ();
587                     }
588                   else
589                     {
590                       lex_error (NULL);
591                       return 0;
592                     }
593                 }
594               else
595                 c->type = RCD_SINGLE;
596             }
597           else
598             {
599               lex_error (_("in source value"));
600               return 0;
601             }
602         }
603       else
604         {
605           assert (type == ALPHA);
606           if (lex_match_id ("CONVERT"))
607             {
608               if ((rcd->flags & RCD_DEST_MASK) == RCD_DEST_ERROR)
609                 rcd->flags |= RCD_DEST_NUMERIC;
610               else if ((rcd->flags & RCD_DEST_MASK) != RCD_DEST_NUMERIC)
611                 {
612                   msg (SE, _("Keyword CONVERT may only be used with "
613                              "string input values and numeric output "
614                              "values."));
615                   return 0;
616                 }
617
618               c->type = RCD_CONVERT;
619               rcd->nmap++;
620               return 2;
621             }
622           else
623             {
624               /* Only the debugging code needs the NULLs at the ends
625                  of the strings.  However, changing code behavior more
626                  than necessary based on the DEBUGGING `#define' is just
627                  *inviting* bugs. */
628               c->type = RCD_SINGLE;
629               if (!lex_force_string ())
630                 return 0;
631               c->f1.c = xmalloc (max_src_width + 1);
632               str_copy_rpad (c->f1.c, max_src_width + 1, ds_c_str (&tokstr));
633               lex_get ();
634             }
635         }
636
637       if (c->type != RCD_END)
638         rcd->nmap++;
639
640       lex_match (',');
641       if (token == '=')
642         break;
643     }
644   return 1;
645 }
646 \f
647 /* Data transformation. */
648
649 static void
650 recode_trns_free (struct trns_header * t)
651 {
652   int i;
653   struct rcd_var *head, *next;
654
655   head = ((struct recode_trns *) t)->codings;
656   while (head)
657     {
658       if (head->map && !(head->flags & RCD_MISC_DUPLICATE))
659         {
660           if (head->flags & RCD_SRC_STRING)
661             for (i = 0; i < head->nmap; i++)
662               switch (head->map[i].type)
663                 {
664                 case RCD_RANGE:
665                   free (head->map[i].f2.c);
666                   /* fall through */
667                 case RCD_USER:
668                 case RCD_SINGLE:
669                 case RCD_HIGH:
670                 case RCD_LOW:
671                   free (head->map[i].f1.c);
672                   break;
673                 case RCD_END:
674                 case RCD_ELSE:
675                 case RCD_CONVERT:
676                   break;
677                 default:
678                   assert (0);
679                 }
680           if (head->flags & RCD_DEST_STRING)
681             for (i = 0; i < head->nmap; i++)
682               if (head->map[i].type != RCD_CONVERT && head->map[i].type != RCD_END)
683                 free (head->map[i].t.c);
684           free (head->map);
685         }
686       next = head->next;
687       free (head);
688       head = next;
689     }
690 }
691
692 static inline struct coding *
693 find_src_numeric (struct rcd_var * v, struct ccase * c)
694 {
695   double cmp = case_num (c, v->src->fv);
696   struct coding *cp;
697
698   if (cmp == SYSMIS)
699     {
700       if (v->sysmis.f != -SYSMIS)
701         {
702           if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
703             case_data_rw (c, v->dest->fv)->f = v->sysmis.f;
704           else
705             memcpy (case_data_rw (c, v->dest->fv)->s, v->sysmis.s,
706                     v->dest->width);
707         }
708       return NULL;
709     }
710
711   for (cp = v->map;; cp++)
712     switch (cp->type)
713       {
714       case RCD_END:
715         return NULL;
716       case RCD_USER:
717         if (is_num_user_missing (cmp, v->src))
718           return cp;
719         break;
720       case RCD_SINGLE:
721         if (cmp == cp->f1.f)
722           return cp;
723         break;
724       case RCD_HIGH:
725         if (cmp >= cp->f1.f)
726           return cp;
727         break;
728       case RCD_LOW:
729         if (cmp <= cp->f1.f)
730           return cp;
731         break;
732       case RCD_RANGE:
733         if (cmp >= cp->f1.f && cmp <= cp->f2.f)
734           return cp;
735         break;
736       case RCD_ELSE:
737         return cp;
738       default:
739         assert (0);
740       }
741 }
742
743 static inline struct coding *
744 find_src_string (struct rcd_var * v, struct ccase * c)
745 {
746   const char *cmp = case_str (c, v->src->fv);
747   int w = v->src->width;
748   struct coding *cp;
749
750   for (cp = v->map;; cp++)
751     switch (cp->type)
752       {
753       case RCD_END:
754         return NULL;
755       case RCD_SINGLE:
756         if (!memcmp (cp->f1.c, cmp, w))
757           return cp;
758         break;
759       case RCD_ELSE:
760         return cp;
761       case RCD_CONVERT:
762         {
763           double f = convert_to_double (cmp, w);
764           if (f != -SYSMIS)
765             {
766               case_data_rw (c, v->dest->fv)->f = f;
767               return NULL;
768             }
769           break;
770         }
771       default:
772         assert (0);
773       }
774 }
775
776 static int
777 recode_trns_proc (struct trns_header * t, struct ccase * c,
778                   int case_idx UNUSED)
779 {
780   struct rcd_var *v;
781
782   for (v = ((struct recode_trns *) t)->codings; v; v = v->next)
783     {
784       struct coding *cp;
785
786       switch (v->flags & RCD_SRC_MASK)
787         {
788         case RCD_SRC_NUMERIC:
789           cp = find_src_numeric (v, c);
790           break;
791         case RCD_SRC_STRING:
792           cp = find_src_string (v, c);
793           break;
794         default:
795           assert (0);
796           abort ();
797         }
798       if (!cp)
799         continue;
800
801       /* A matching input value was found. */
802       if ((v->flags & RCD_DEST_MASK) == RCD_DEST_NUMERIC)
803         {
804           double val = cp->t.f;
805           double *out = &case_data_rw (c, v->dest->fv)->f;
806           if (val == -SYSMIS)
807             *out = case_num (c, v->src->fv);
808           else
809             *out = val;
810         }
811       else
812         {
813           char *val = cp->t.c;
814           if (val == NULL) 
815             {
816               if (v->dest->fv != v->src->fv)
817                 buf_copy_rpad (case_data_rw (c, v->dest->fv)->s,
818                                v->dest->width,
819                                case_str (c, v->src->fv), v->src->width); 
820             }
821           else
822             memcpy (case_data_rw (c, v->dest->fv)->s, cp->t.c, v->dest->width);
823         }
824     }
825
826   return -1;
827 }
828
829 /* Convert NPTR to a `long int' in base 10.  Returns the long int on
830    success, NOT_LONG on failure.  On success stores a pointer to the
831    first character after the number into *ENDPTR.  From the GNU C
832    library. */
833 static long int
834 string_to_long (const char *nptr, int width, const char **endptr)
835 {
836   int negative;
837   register unsigned long int cutoff;
838   register unsigned int cutlim;
839   register unsigned long int i;
840   register const char *s;
841   register unsigned char c;
842   const char *save;
843
844   s = nptr;
845
846   /* Check for a sign.  */
847   if (*s == '-')
848     {
849       negative = 1;
850       ++s;
851     }
852   else if (*s == '+')
853     {
854       negative = 0;
855       ++s;
856     }
857   else
858     negative = 0;
859   if (s >= nptr + width)
860     return NOT_LONG;
861
862   /* Save the pointer so we can check later if anything happened.  */
863   save = s;
864
865   cutoff = ULONG_MAX / 10ul;
866   cutlim = ULONG_MAX % 10ul;
867
868   i = 0;
869   for (c = *s;;)
870     {
871       if (isdigit ((unsigned char) c))
872         c -= '0';
873       else
874         break;
875       /* Check for overflow.  */
876       if (i > cutoff || (i == cutoff && c > cutlim))
877         return NOT_LONG;
878       else
879         i = i * 10ul + c;
880
881       s++;
882       if (s >= nptr + width)
883         break;
884       c = *s;
885     }
886
887   /* Check if anything actually happened.  */
888   if (s == save)
889     return NOT_LONG;
890
891   /* Check for a value that is within the range of `unsigned long
892      int', but outside the range of `long int'.  We limit LONG_MIN and
893      LONG_MAX by one point because we know that NOT_LONG is out there
894      somewhere. */
895   if (i > (negative
896            ? -((unsigned long int) LONG_MIN) - 1
897            : ((unsigned long int) LONG_MAX) - 1))
898     return NOT_LONG;
899
900   *endptr = s;
901
902   /* Return the result of the appropriate sign.  */
903   return (negative ? -i : i);
904 }
905
906 /* Converts S to a double according to format Fx.0.  Returns the value
907    found, or -SYSMIS if there was no valid number in s.  WIDTH is the
908    length of string S.  From the GNU C library. */
909 static double
910 convert_to_double (const char *s, int width)
911 {
912   register const char *end = &s[width];
913
914   short int sign;
915
916   /* The number so far.  */
917   double num;
918
919   int got_dot;                  /* Found a decimal point.  */
920   int got_digit;                /* Count of digits.  */
921
922   /* The exponent of the number.  */
923   long int exponent;
924
925   /* Eat whitespace.  */
926   while (s < end && isspace ((unsigned char) *s))
927     ++s;
928   if (s >= end)
929     return SYSMIS;
930
931   /* Get the sign.  */
932   sign = *s == '-' ? -1 : 1;
933   if (*s == '-' || *s == '+')
934     {
935       ++s;
936       if (s >= end)
937         return -SYSMIS;
938     }
939
940   num = 0.0;
941   got_dot = 0;
942   got_digit = 0;
943   exponent = 0;
944   for (; s < end; ++s)
945     {
946       if (isdigit ((unsigned char) *s))
947         {
948           got_digit++;
949
950           /* Make sure that multiplication by 10 will not overflow.  */
951           if (num > DBL_MAX * 0.1)
952             /* The value of the digit doesn't matter, since we have already
953                gotten as many digits as can be represented in a `double'.
954                This doesn't necessarily mean the result will overflow.
955                The exponent may reduce it to within range.
956
957                We just need to record that there was another
958                digit so that we can multiply by 10 later.  */
959             ++exponent;
960           else
961             num = (num * 10.0) + (*s - '0');
962
963           /* Keep track of the number of digits after the decimal point.
964              If we just divided by 10 here, we would lose precision.  */
965           if (got_dot)
966             --exponent;
967         }
968       else if (!got_dot && *s == '.')
969         /* Record that we have found the decimal point.  */
970         got_dot = 1;
971       else
972         break;
973     }
974
975   if (!got_digit)
976     return -SYSMIS;
977
978   if (s < end && (tolower ((unsigned char) (*s)) == 'e'
979                   || tolower ((unsigned char) (*s)) == 'd'))
980     {
981       /* Get the exponent specified after the `e' or `E'.  */
982       long int exp;
983
984       s++;
985       if (s >= end)
986         return -SYSMIS;
987
988       exp = string_to_long (s, end - s, &s);
989       if (exp == NOT_LONG || end == s)
990         return -SYSMIS;
991       exponent += exp;
992     }
993
994   while (s < end && isspace ((unsigned char) *s))
995     s++;
996   if (s < end)
997     return -SYSMIS;
998
999   if (num == 0.0)
1000     return 0.0;
1001
1002   /* Multiply NUM by 10 to the EXPONENT power,
1003      checking for overflow and underflow.  */
1004
1005   if (exponent < 0)
1006     {
1007       if (-exponent + got_digit > -(DBL_MIN_10_EXP) + 5
1008           || num < DBL_MIN * pow (10.0, (double) -exponent))
1009         return -SYSMIS;
1010       num *= pow (10.0, (double) exponent);
1011     }
1012   else if (exponent > 0)
1013     {
1014       if (num > DBL_MAX * pow (10.0, (double) -exponent))
1015         return -SYSMIS;
1016       num *= pow (10.0, (double) exponent);
1017     }
1018
1019   return sign > 0 ? num : -num;
1020 }