Fixed bugs #11722 and #11676

[pspp] / src / expr-prs.c

diff --git a/src/expr-prs.c b/src/expr-prs.c
index acf8c3c664aeb134f89cba35273ddc1efc409ba7..71e03a8695e47246aee67520df96b8a3070d0df7 100644 (file)
--- a/src/expr-prs.c
+++ b/src/expr-prs.c
@@ -18,6 +18,7 @@
    02111-1307, USA. */
 
 #include <config.h>
+#include "dictionary.h"
 #include "expr.h"
 #include "exprP.h"
 #include "error.h"
@@ -60,10 +61,6 @@ static int type_check (union any_node **n,
 
 static algo_compare_func compare_functions;
 static void init_func_tab (void);
-
-#if DEBUGGING
-static void debug_print_tree (union any_node *, int);
-#endif
 \f
 /* Public functions. */
 
@@ -86,7 +83,7 @@ struct expression *
 expr_parse (enum expr_type expected_type)
 {
   struct expression *e;
-  union any_node *n;
+  union any_node *n=0;
   enum expr_type actual_type;
   int optimize = (expected_type & EXPR_NO_OPTIMIZE) == 0;
 
@@ -615,7 +612,7 @@ parse_primary (union any_node **n)
 
     case T_STRING:
       {
-        *n = allocate_str_con (ds_value (&tokstr), ds_length (&tokstr));
+        *n = allocate_str_con (ds_c_str (&tokstr), ds_length (&tokstr));
        lex_get ();
        return EXPR_STRING;
       }
@@ -971,6 +968,7 @@ CONCAT_func (const struct function *f UNUSED, int x UNUSED, union any_node **n)
       type = parse_or (&(*n)->nonterm.arg[(*n)->nonterm.n]);
       if (type == EXPR_ERROR)
        goto fail;
+      (*n)->nonterm.n++;
       if (type != EXPR_STRING)
        {
          msg (SE, _("Argument %d to CONCAT is type %s.  All arguments "
@@ -978,7 +976,6 @@ CONCAT_func (const struct function *f UNUSED, int x UNUSED, union any_node **n)
               (*n)->nonterm.n + 1, expr_type_name (type));
          goto fail;
        }
-      (*n)->nonterm.n++;
 
       if (!lex_match (','))
        break;
@@ -1068,6 +1065,7 @@ generic_str_func (const struct function *f, int x UNUSED, union any_node **n)
            goto fail;
           else if (actual_type == EXPR_BOOLEAN)
             actual_type = EXPR_NUMERIC;
+          nonterm->n++;
          if (actual_type != wanted_type)
            {
              msg (SE, _("Argument %d to %s was expected to be of %s type.  "
@@ -1076,7 +1074,6 @@ generic_str_func (const struct function *f, int x UNUSED, union any_node **n)
                   expr_type_name (actual_type), expr_type_name (wanted_type));
              goto fail;
            }
-         nonterm->n++;
        }
       else if (*cp == 'f')
        {
@@ -1223,7 +1220,7 @@ parse_function (union any_node ** n)
     }
 
   ds_truncate (&tokstr, 31);
-  strcpy (fname, ds_value (&tokstr));
+  strcpy (fname, ds_c_str (&tokstr));
   cp = strrchr (fname, '.');
   if (cp && isdigit ((unsigned char) cp[1]))
     {
@@ -1519,84 +1516,6 @@ init_func_tab (void)
 \f
 /* Debug output. */
 
-#if DEBUGGING
-static void
-print_type (union any_node * n)
-{
-  const char *s;
-  size_t len;
-
-  s = ops[n->type].name;
-  len = strlen (s);
-  if (ops[n->type].flags & OP_MIN_ARGS)
-    printf ("%s.%d\n", s, (int) n->nonterm.arg[n->nonterm.n]);
-  else if (ops[n->type].flags & OP_FMT_SPEC)
-    {
-      struct fmt_spec f;
-
-      f.type = (int) n->nonterm.arg[n->nonterm.n + 0];
-      f.w = (int) n->nonterm.arg[n->nonterm.n + 1];
-      f.d = (int) n->nonterm.arg[n->nonterm.n + 2];
-      printf ("%s(%s)\n", s, fmt_to_string (&f));
-    }
-  else
-    printf ("%s\n", s);
-}
-
-static void
-debug_print_tree (union any_node * n, int level)
-{
-  int i;
-  for (i = 0; i < level; i++)
-    printf ("  ");
-  if (n->type < OP_TERMINAL)
-    {
-      print_type (n);
-      for (i = 0; i < n->nonterm.n; i++)
-       debug_print_tree (n->nonterm.arg[i], level + 1);
-    }
-  else
-    {
-      switch (n->type)
-       {
-       case OP_TERMINAL:
-         printf (_("!!TERMINAL!!"));
-         break;
-       case OP_NUM_CON:
-         if (n->num_con.value == SYSMIS)
-           printf ("SYSMIS");
-         else
-           printf ("%f", n->num_con.value);
-         break;
-       case OP_STR_CON:
-         printf ("\"%.*s\"", n->str_con.len, n->str_con.s);
-         break;
-       case OP_NUM_VAR:
-       case OP_STR_VAR:
-         printf ("%s", n->var.v->name);
-         break;
-       case OP_NUM_LAG:
-       case OP_STR_LAG:
-         printf ("LAG(%s,%d)", n->lag.v->name, n->lag.lag);
-         break;
-       case OP_NUM_SYS:
-         printf ("SYSMIS(%s)", n->var.v->name);
-         break;
-       case OP_NUM_VAL:
-         printf ("VALUE(%s)", n->var.v->name);
-         break;
-       case OP_SENTINEL:
-         printf (_("!!SENTINEL!!"));
-         break;
-       default:
-         printf (_("!!ERROR%d!!"), n->type);
-         assert (0);
-       }
-      printf ("\n");
-    }
-}
-#endif /* DEBUGGING */
-
 void
 expr_debug_print_postfix (const struct expression *e)
 {
@@ -1682,3 +1601,75 @@ struct op_desc ops[OP_SENTINEL] =
   {
 #include "expr.def"
   };
+\f
+#include "command.h"
+
+int
+cmd_debug_evaluate (void)
+{
+  struct expression *expr;
+  union value value;
+  enum expr_type expr_flags;
+  int dump_postfix = 0;
+
+  discard_variables ();
+
+  expr_flags = 0;
+  if (lex_match_id ("NOOPTIMIZE"))
+    expr_flags |= EXPR_NO_OPTIMIZE;
+  if (lex_match_id ("POSTFIX"))
+    dump_postfix = 1;
+  if (token != '/') 
+    {
+      lex_force_match ('/');
+      return CMD_FAILURE;
+    }
+  fprintf (stderr, "%s => ", lex_rest_of_line (NULL));
+  lex_get ();
+
+  expr = expr_parse (EXPR_ANY | expr_flags);
+  if (!expr || token != '.') 
+    {
+      if (expr != NULL)
+        expr_free (expr);
+      fprintf (stderr, "error\n");
+      return CMD_FAILURE; 
+    }
+
+  if (dump_postfix) 
+    expr_debug_print_postfix (expr);
+  else 
+    {
+      expr_evaluate (expr, NULL, 0, &value);
+      switch (expr_get_type (expr)) 
+        {
+        case EXPR_NUMERIC:
+          if (value.f == SYSMIS)
+            fprintf (stderr, "sysmis\n");
+          else
+            fprintf (stderr, "%.2f\n", value.f);
+          break;
+      
+        case EXPR_BOOLEAN:
+          if (value.f == SYSMIS)
+            fprintf (stderr, "sysmis\n");
+          else if (value.f == 0.0)
+            fprintf (stderr, "false\n");
+          else
+            fprintf (stderr, "true\n");
+          break;
+
+        case EXPR_STRING:
+          fputc ('"', stderr);
+          fwrite (value.c + 1, value.c[0], 1, stderr);
+          fputs ("\"\n", stderr);
+          break;
+
+        default:
+          assert (0);
+        }
+    }
+  
+  expr_free (expr);
+  return CMD_SUCCESS;
+}