? valuelabel.patch
? src/language/expressions/generate
Index: doc/expressions.texi
===================================================================
RCS file: /cvsroot/pspp/pspp/doc/expressions.texi,v
retrieving revision 1.6
diff -u -p -r1.6 expressions.texi
--- doc/expressions.texi	1 May 2006 22:33:51 -0000	1.6
+++ doc/expressions.texi	11 Dec 2006 00:52:51 -0000
@@ -260,7 +260,7 @@ The sections below describe each functio
 * String Functions::            CONCAT INDEX LENGTH LOWER LPAD LTRIM NUMBER 
                                 RINDEX RPAD RTRIM STRING SUBSTR UPCASE
 * Time & Date::                 CTIME.xxx DATE.xxx TIME.xxx XDATE.xxx
-* Miscellaneous Functions::     LAG YRMODA
+* Miscellaneous Functions::     LAG YRMODA VALUELABEL
 * Statistical Distribution Functions::  PDF CDF SIG IDF RV NPDF NCDF
 @end menu
 
@@ -1066,6 +1066,13 @@ the date specified, plus one.  The date 
 on or after 15 Oct 1582.  15 Oct 1582 has a value of 1.
 @end deftypefn
 
+@cindex value label
+@deftypefn {Function} VALUELABEL (@var{variable})
+Returns the value label associated with the value of @var{variable},
+which may name a numeric or string variable.  If @var{variable}'s
+value has no value label, returns the empty string.
+@end deftypefn
+
 @node Statistical Distribution Functions
 @subsection Statistical Distribution Functions
 
Index: src/language/expressions/ChangeLog
===================================================================
RCS file: /cvsroot/pspp/pspp/src/language/expressions/ChangeLog,v
retrieving revision 1.6
diff -u -p -r1.6 ChangeLog
--- src/language/expressions/ChangeLog	14 Jul 2006 02:28:29 -0000	1.6
+++ src/language/expressions/ChangeLog	11 Dec 2006 00:52:52 -0000
@@ -1,3 +1,28 @@
+Sun Dec 10 16:49:33 2006  Ben Pfaff  <blp@gnu.org>
+
+	* operations.def: Implement VALUELABEL function.  Add DATEDIFF,
+	DATESUM unimplemented stubs.
+
+	* parse.c (type_coercion_core): Add support for OP_var type, which
+	is a name for a numeric or string variable.
+	(is_compatible) New function.
+	(check_operator) Only require values to be compatible with their
+	expected types, not identical.
+	(is_valid_node) Ditto.
+	(compare_names) Always return mismatch if the command name can't
+	be abbreviated.
+	(lookup_function_helper) Pass the new OPF_NO_ABBREV flag to the
+	comparison function.
+
+	* generate.pl (init_all_types): Add support for a type just called
+	"var" that may be a numeric or string variable name.  Also, add a
+	no_abbrev option that prevents a function name from being
+	abbreviated (in case of naming conflict otherwise).
+	
+	* parse.inc.pl: Output OPF_NO_ABBREV flag.
+
+	* private.h: Add OPF_NO_ABBREV flag.
+
 Wed Jul 12 21:03:17 2006  Ben Pfaff  <blp@gnu.org>
 
 	* evaluate.c (cmd_debug_evaluate): Don't try to resize a null
Index: src/language/expressions/generate.pl
===================================================================
RCS file: /cvsroot/pspp/pspp/src/language/expressions/generate.pl,v
retrieving revision 1.4
diff -u -p -r1.4 generate.pl
--- src/language/expressions/generate.pl	26 Oct 2006 06:16:36 -0000	1.4
+++ src/language/expressions/generate.pl	11 Dec 2006 00:52:52 -0000
@@ -99,6 +99,9 @@ sub init_all_types {
     init_type ('str_var', 'leaf', C_TYPE => 'const struct variable *',
 	       ATOM => 'variable', MANGLE => 'Vs',
 	       HUMAN_NAME => 'string_variable');
+    init_type ('var', 'leaf', C_TYPE => 'const struct variable *',
+	       ATOM => 'variable', MANGLE => 'V',
+	       HUMAN_NAME => 'variable');
 
     # Vectors.
     init_type ('vector', 'leaf', C_TYPE => 'const struct vector *',
@@ -245,6 +248,8 @@ sub parse_input {
 		$op{ABSORB_MISS} = 1;
 	    } elsif (match ('perm_only')) {
 		$op{PERM_ONLY} = 1;
+	    } elsif (match ('no_abbrev')) {
+		$op{NO_ABBREV} = 1;
 	    } else {
 		last;
 	    }
Index: src/language/expressions/operations.def
===================================================================
RCS file: /cvsroot/pspp/pspp/src/language/expressions/operations.def,v
retrieving revision 1.11
diff -u -p -r1.11 operations.def
--- src/language/expressions/operations.def	10 Dec 2006 03:42:51 -0000	1.11
+++ src/language/expressions/operations.def	11 Dec 2006 00:52:52 -0000
@@ -318,6 +318,12 @@ function XDATE.WEEK (date >= DAY_S)
 function XDATE.WKDAY (date >= DAY_S) = calendar_offset_to_wday (date / DAY_S);
 function XDATE.YEAR (date >= DAY_S) = calendar_offset_to_year (date / DAY_S);
 
+// Date arithmetic functions.
+function DATEDIFF (date1, date2, string unit) = unimplemented;
+function DATESUM (date, quantity, string unit) = unimplemented;
+function DATESUM (date, quantity, string unit, string roll_over)
+     = unimplemented;
+
 // String functions.
 string function CONCAT (string a[n])
      expression e;
@@ -607,6 +613,17 @@ absorb_miss string function SUBSTR (stri
     return empty_string;
 }
 
+absorb_miss no_opt string function VALUELABEL (var v)
+     expression e;
+     case c;
+{
+  const char *label = var_lookup_value_label (v, case_data (c, v));
+  if (label != NULL)
+    return copy_string (e, label, strlen (label));
+  else
+    return empty_string;
+}
+
 // Artificial.
 operator SQUARE (x) = x * x;
 boolean operator NUM_TO_BOOLEAN (x)
Index: src/language/expressions/parse.c
===================================================================
RCS file: /cvsroot/pspp/pspp/src/language/expressions/parse.c,v
retrieving revision 1.20
diff -u -p -r1.20 parse.c
--- src/language/expressions/parse.c	10 Dec 2006 03:42:51 -0000	1.20
+++ src/language/expressions/parse.c	11 Dec 2006 00:52:53 -0000
@@ -400,6 +400,15 @@ type_coercion_core (struct expression *e
         }
       break;
 
+    case OP_var:
+      if ((*node)->type == OP_NUM_VAR || (*node)->type == OP_STR_VAR)
+        {
+          if (do_coercion)
+            *node = (*node)->composite.args[0];
+          return true;
+        }
+      break;
+
     case OP_pos_int:
       if ((*node)->type == OP_number
           && floor ((*node)->number.n) == (*node)->number.n
@@ -456,6 +465,16 @@ is_coercible (atom_type required_type, u
                              (union any_node **) node, NULL, false);
 }
 
+/* Returns true if ACTUAL_TYPE is a kind of REQUIRED_TYPE, false
+   otherwise. */
+static bool
+is_compatible (atom_type required_type, atom_type actual_type) 
+{
+  return (required_type == actual_type
+          || (required_type == OP_var
+              && (actual_type == OP_num_var || actual_type == OP_str_var)));
+}
+
 /* How to parse an operator. */
 struct operator
   {
@@ -502,7 +521,7 @@ check_operator (const struct operator *o
   assert (o->arg_cnt == arg_cnt);
   assert ((o->flags & OPF_ARRAY_OPERAND) == 0);
   for (i = 0; i < arg_cnt; i++) 
-    assert (o->args[i] == arg_type);
+    assert (is_compatible (arg_type, o->args[i]));
   return true;
 }
 
@@ -944,8 +963,11 @@ word_matches (const char **test, const c
 }
 
 static int
-compare_names (const char *test, const char *name) 
+compare_names (const char *test, const char *name, bool abbrev_ok) 
 {
+  if (!abbrev_ok)
+    return true;
+  
   for (;;) 
     {
       if (!word_matches (&test, &name))
@@ -956,14 +978,15 @@ compare_names (const char *test, const c
 }
 
 static int
-compare_strings (const char *test, const char *name) 
+compare_strings (const char *test, const char *name, bool abbrev_ok UNUSED)
 {
   return strcasecmp (test, name);
 }
 
 static bool
 lookup_function_helper (const char *name,
-                        int (*compare) (const char *test, const char *name),
+                        int (*compare) (const char *test, const char *name,
+                                        bool abbrev_ok),
                         const struct operation **first,
                         const struct operation **last)
 {
@@ -971,11 +994,12 @@ lookup_function_helper (const char *name
   
   for (f = operations + OP_function_first;
        f <= operations + OP_function_last; f++) 
-    if (!compare (name, f->name)) 
+    if (!compare (name, f->name, !(f->flags & OPF_NO_ABBREV))) 
       {
         *first = f;
 
-        while (f <= operations + OP_function_last && !compare (name, f->name))
+        while (f <= operations + OP_function_last
+               && !compare (name, f->name, !(f->flags & OPF_NO_ABBREV)))
           f++;
         *last = f;
 
@@ -1355,13 +1379,13 @@ is_valid_node (union any_node *n) 
       assert (is_composite (n->type));
       assert (c->arg_cnt >= op->arg_cnt);
       for (i = 0; i < op->arg_cnt; i++) 
-        assert (expr_node_returns (c->args[i]) == op->args[i]);
+        assert (is_compatible (op->args[i], expr_node_returns (c->args[i])));
       if (c->arg_cnt > op->arg_cnt && !is_operator (n->type)) 
         {
           assert (op->flags & OPF_ARRAY_OPERAND);
           for (i = 0; i < c->arg_cnt; i++)
-            assert (operations[c->args[i]->type].returns
-                    == op->args[op->arg_cnt - 1]);
+            assert (is_compatible (op->args[op->arg_cnt - 1],
+                                   expr_node_returns (c->args[i])));
         }
     }
 
Index: src/language/expressions/parse.inc.pl
===================================================================
RCS file: /cvsroot/pspp/pspp/src/language/expressions/parse.inc.pl,v
retrieving revision 1.2
diff -u -p -r1.2 parse.inc.pl
--- src/language/expressions/parse.inc.pl	1 May 2006 22:14:53 -0000	1.2
+++ src/language/expressions/parse.inc.pl	11 Dec 2006 00:52:54 -0000
@@ -56,6 +56,7 @@ sub generate_output {
 	push (@flags, "OPF_EXTENSION") if $op->{EXTENSION};
 	push (@flags, "OPF_UNIMPLEMENTED") if $op->{UNIMPLEMENTED};
 	push (@flags, "OPF_PERM_ONLY") if $op->{PERM_ONLY};
+	push (@flags, "OPF_NO_ABBREV") if $op->{NO_ABBREV};
 	push (@members, @flags ? join (' | ', @flags) : 0);
 
 	push (@members, "OP_$op->{RETURNS}{NAME}");
Index: src/language/expressions/private.h
===================================================================
RCS file: /cvsroot/pspp/pspp/src/language/expressions/private.h,v
retrieving revision 1.7
diff -u -p -r1.7 private.h
--- src/language/expressions/private.h	11 Nov 2006 23:10:00 -0000	1.7
+++ src/language/expressions/private.h	11 Dec 2006 00:52:54 -0000
@@ -62,7 +62,10 @@ enum operation_flags 
 
     /* If set, this operation may not occur after TEMPORARY.
        (Currently this applies only to LAG.) */
-    OPF_PERM_ONLY = 0100
+    OPF_PERM_ONLY = 0100,
+
+    /* If set, this operation's name may not be abbreviated. */
+    OPF_NO_ABBREV = 0200
   };
 
 #define EXPR_ARG_MAX 4
Index: tests/ChangeLog
===================================================================
RCS file: /cvsroot/pspp/pspp/tests/ChangeLog,v
retrieving revision 1.69
diff -u -p -r1.69 ChangeLog
--- tests/ChangeLog	1 Dec 2006 06:51:08 -0000	1.69
+++ tests/ChangeLog	11 Dec 2006 00:52:54 -0000
@@ -1,53 +1,59 @@
+Sun Dec 10 16:52:04 2006  Ben Pfaff  <blp@gnu.org>
+
+	* automake.mk: Add new test.
+
+	* expressions/valuelabel.sh: New test, for VALUELABEL function.
+
 Thu Nov 30 22:46:17 2006  Ben Pfaff  <blp@gnu.org>
 
 	* automake.mk: Add new test.
 
-	* tests/bugs/compute-sum.sh: New test, for bug #17422.
+	* bugs/compute-sum.sh: New test, for bug #17422.
 
 Thu Nov 30 22:01:57 2006  Ben Pfaff  <blp@gnu.org>
 
 	* automake.mk: Add new test.
 
-	* tests/bugs/empty-do-repeat: New test, for bug #18407.
+	* bugs/empty-do-repeat: New test, for bug #18407.
 
 Wed Nov 22 06:28:04 2006  Ben Pfaff  <blp@gnu.org>
 
-	* tests/bugs/signals.sh: Fix race condition.
+	* bugs/signals.sh: Fix race condition.
 
 Sun Nov 19 09:23:34 2006  Ben Pfaff  <blp@gnu.org>
 
 	* automake.mk: Add the new tests listed below.
 
-	* tests/formats/bcd-in.sh: New test.
+	* formats/bcd-in.sh: New test.
 
-	* tests/formats/bcd-in.expected.cmp.gz: New support file for
+	* formats/bcd-in.expected.cmp.gz: New support file for
 	bcd-in.sh.
 
-	* tests/formats/date-in.sh: New test.
+	* formats/date-in.sh: New test.
 
-	* tests/formats/ib-in.sh: New test.
+	* formats/ib-in.sh: New test.
 
-	* tests/formats/ib-in.expected.cmp.gz: New test.
+	* formats/ib-in.expected.cmp.gz: New test.
 
-	* tests/formats/legacy-in.sh: New test.
+	* formats/legacy-in.sh: New test.
 
-	* tests/formats/legacy-in.expected.cmp.gz: New support file for
+	* formats/legacy-in.expected.cmp.gz: New support file for
 	legacy-in.sh.
 
-	* tests/formats/month-in.sh: New test.
+	* formats/month-in.sh: New test.
 
-	* tests/formats/num-in.sh: New test.
+	* formats/num-in.sh: New test.
 
-	* tests/formats/num-in.expected.gz: New support file for num-in.sh.
+	* formats/num-in.expected.gz: New support file for num-in.sh.
 
-	* tests/formats/time-in.sh: New test.
+	* formats/time-in.sh: New test.
 
-	* tests/formats/wkday-in.sh: New test.
+	* formats/wkday-in.sh: New test.
 
-	* tests/commands/no_case_size.sh: Update output to conform with
+	* commands/no_case_size.sh: Update output to conform with
 	update scientific notation code.
 
-	* tests/formats/num-out.expected.cmp.gz: Ditto.
+	* formats/num-out.expected.cmp.gz: Ditto.
 
 Thu Nov  2 20:58:12 2006  Ben Pfaff  <blp@gnu.org>
 
@@ -81,7 +87,7 @@ Thu Oct 26 20:20:39 2006  Ben Pfaff  <bl
 
 	* automake.mk: Add tests/formats/float-format.sh.
 
-	* tests/formats/float-format.sh: New test.
+	* formats/float-format.sh: New test.
 
 Sat Oct  7 11:06:59 WST 2006 John Darrington <john@darrington.wattle.id.au>
 
Index: tests/automake.mk
===================================================================
RCS file: /cvsroot/pspp/pspp/tests/automake.mk,v
retrieving revision 1.20
diff -u -p -r1.20 automake.mk
--- tests/automake.mk	1 Dec 2006 06:51:08 -0000	1.20
+++ tests/automake.mk	11 Dec 2006 00:52:54 -0000
@@ -124,6 +124,7 @@ TESTS = \
 	tests/expressions/expressions.sh \
 	tests/expressions/epoch.sh \
 	tests/expressions/randist.sh \
+	tests/expressions/valuelabel.sh \
 	tests/expressions/variables.sh \
 	tests/expressions/vectors.sh \
 	tests/libpspp/ll-test \
Index: tests/expressions/valuelabel.sh
===================================================================
RCS file: tests/expressions/valuelabel.sh
diff -N tests/expressions/valuelabel.sh
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/expressions/valuelabel.sh	11 Dec 2006 00:52:55 -0000
@@ -0,0 +1,110 @@
+#!/bin/sh
+
+# This program tests use of the VALUELABEL function in expressions.
+
+TEMPDIR=/tmp/pspp-tst-$$
+
+# ensure that top_srcdir and top_builddir  are absolute
+if [ -z "$top_srcdir" ] ; then top_srcdir=. ; fi
+if [ -z "$top_builddir" ] ; then top_builddir=. ; fi
+top_srcdir=`cd $top_srcdir; pwd`
+top_builddir=`cd $top_builddir; pwd`
+PSPP=$top_builddir/src/ui/terminal/pspp
+
+STAT_CONFIG_PATH=$top_srcdir/config
+export STAT_CONFIG_PATH
+
+LANG=C
+export LANG
+
+cleanup()
+{
+     cd /
+     rm -rf $TEMPDIR
+}
+
+
+fail()
+{
+    echo $activity
+    echo FAILED
+    cleanup;
+    exit 1;
+}
+
+
+no_result()
+{
+    echo $activity
+    echo NO RESULT;
+    cleanup;
+    exit 2;
+}
+
+pass()
+{
+    cleanup;
+    exit 0;
+}
+
+mkdir -p $TEMPDIR
+
+cd $TEMPDIR
+
+activity="create program"
+cat > $TEMPDIR/valuelabel.stat <<EOF
+DATA LIST notable /n 1 s 2(a).
+VALUE LABELS /n 0 'Very dissatisfied'
+                1 'Dissatisfied'
+                2 'Neutral'
+                3 'Satisfied'
+                4 'Very satisfied'.
+VALUE LABELS /s 'a' 'Wouldn''t buy again'
+                'b' 'Unhappy'
+                'c' 'Bored'
+                'd' 'Satiated'
+                'e' 'Elated'.
+STRING nlabel slabel(a10).
+COMPUTE nlabel = VALUELABEL(n).
+COMPUTE slabel = VALUELABEL(s).
+LIST.
+BEGIN DATA.
+
+0a
+1b
+2c
+3d
+4e
+5f
+6g
+END DATA.
+EOF
+if [ $? -ne 0 ] ; then no_result ; fi
+
+activity="run program"
+$SUPERVISOR $PSPP -o raw-ascii $TEMPDIR/valuelabel.stat
+if [ $? -ne 0 ] ; then fail ; fi
+
+activity="compare results"
+perl -pi -e 's/^\s*$//g' $TEMPDIR/pspp.list
+diff -b  $TEMPDIR/pspp.list - <<EOF
+n s     nlabel     slabel
+- - ---------- ----------
+.                         
+0 a Very dissa Wouldn't b 
+1 b Dissatisfi Unhappy    
+2 c Neutral    Bored      
+3 d Satisfied  Satiated   
+4 e Very satis Elated     
+5 f                       
+6 g                       
+EOF
+
+if [ $? -ne 0 ] ; then no_result ; fi
+
+
+if [ $? -ne 0 ] ; then fail ; fi
+
+
+
+pass;
