more tests
[pspp] / src / language / expressions / parse.c
index 7eccdac2b12810b28b29bd5d8aa9c7016a47fa08..1e3844a6cf1a1d0541407a634ee1d44f2714cb05 100644 (file)
@@ -67,6 +67,15 @@ static struct expr_node *allocate_unary_variable (struct expression *,
 \f
 /* Public functions. */
 
+static struct expr_node *
+parse_expr (struct lexer *lexer, struct expression *e)
+{
+  struct expr_node *n = parse_or (lexer, e);
+  if (n && n->type == OP_VEC_ELEM_NUM_RAW)
+    n->type = OP_VEC_ELEM_NUM;
+  return n;
+}
+
 /* Parses an expression of the given TYPE.  If DS is nonnull then variables and
    vectors within it may be referenced within the expression; otherwise, the
    expression must not reference any variables or vectors.  Returns the new
@@ -77,7 +86,7 @@ expr_parse (struct lexer *lexer, struct dataset *ds, enum val_type type)
   assert (val_type_is_valid (type));
 
   struct expression *e = expr_create (ds);
-  struct expr_node *n = parse_or (lexer, e);
+  struct expr_node *n = parse_expr (lexer, e);
   if (!n || !type_check (e, n, type))
     {
       expr_free (e);
@@ -92,7 +101,7 @@ struct expression *
 expr_parse_bool (struct lexer *lexer, struct dataset *ds)
 {
   struct expression *e = expr_create (ds);
-  struct expr_node *n = parse_or (lexer, e);
+  struct expr_node *n = parse_expr (lexer, e);
   if (!n)
     {
       expr_free (e);
@@ -101,7 +110,8 @@ expr_parse_bool (struct lexer *lexer, struct dataset *ds)
 
   atom_type actual_type = expr_node_returns (n);
   if (actual_type == OP_number)
-    n = expr_allocate_unary (e, OP_NUM_TO_BOOLEAN, n);
+    n = expr_allocate_binary (e, OP_EXPR_TO_BOOLEAN, n,
+                              expr_allocate_expr_node (e, n));
   else if (actual_type != OP_boolean)
     {
       msg_at (SE, expr_location (e, n),
@@ -123,7 +133,7 @@ expr_parse_new_variable (struct lexer *lexer, struct dataset *ds,
                          const char *new_var_name)
 {
   struct expression *e = expr_create (ds);
-  struct expr_node *n = parse_or (lexer, e);
+  struct expr_node *n = parse_expr (lexer, e);
   if (!n)
     {
       expr_free (e);
@@ -160,7 +170,7 @@ expr_parse_any (struct lexer *lexer, struct dataset *ds, bool optimize)
   struct expression *e;
 
   e = expr_create (ds);
-  n = parse_or (lexer, e);
+  n = parse_expr (lexer, e);
   if (n == NULL)
     {
       expr_free (e);
@@ -197,6 +207,7 @@ atom_type_stack (atom_type type)
     {
     case OP_number:
     case OP_boolean:
+    case OP_num_vec_elem:
       return &on_number_stack;
 
     case OP_string:
@@ -210,6 +221,7 @@ atom_type_stack (atom_type type)
     case OP_integer:
     case OP_pos_int:
     case OP_vector:
+    case OP_expr_node:
       return &not_on_stack;
 
     default:
@@ -438,6 +450,12 @@ type_coercion__ (struct expression *e, struct expr_node *node, size_t arg_idx,
             *argp = expr_allocate_unary (e, OP_BOOLEAN_TO_NUM, arg);
           return true;
         }
+      else if (actual_type == OP_num_vec_elem)
+        {
+          if (do_coercion)
+            arg->type = OP_VEC_ELEM_NUM;
+          return true;
+        }
       break;
 
     case OP_string:
@@ -449,7 +467,8 @@ type_coercion__ (struct expression *e, struct expr_node *node, size_t arg_idx,
         {
           /* Convert numeric to boolean. */
           if (do_coercion)
-            *argp = expr_allocate_unary (e, OP_NUM_TO_BOOLEAN, arg);
+            *argp = expr_allocate_binary (e, OP_OPERAND_TO_BOOLEAN, arg,
+                                          expr_allocate_expr_node (e, node));
           return true;
         }
       break;
@@ -465,6 +484,7 @@ type_coercion__ (struct expression *e, struct expr_node *node, size_t arg_idx,
       break;
 
     case OP_format:
+      /* We never coerce to OP_format, only to OP_ni_format or OP_no_format. */
       NOT_REACHED ();
 
     case OP_ni_format:
@@ -727,8 +747,7 @@ parse_rel (struct lexer *lexer, struct expression *e)
       "not produce the mathematically expected result.  "
       "Use the AND logical operator to fix the problem "
       "(e.g. `a < b AND b < c').  "
-      "If chaining is really intended, parentheses will disable "
-      "this warning (e.g. `(a < b) < c'.)");
+      "To disable this warning, insert parentheses.");
 
   static const struct operator ops[] =
     {
@@ -789,7 +808,7 @@ parse_exp (struct lexer *lexer, struct expression *e)
 
   const char *chain_warning =
     _("The exponentiation operator (`**') is left-associative: "
-      "`a**b**c' equals `(a**b)**c', not as `a**(b**c)'.  "
+      "`a**b**c' equals `(a**b)**c', not `a**(b**c)'.  "
       "To disable this warning, insert parentheses.");
 
   if (lex_token (lexer) != T_NEG_NUM || lex_next_token (lexer, 1) != T_EXP)
@@ -802,6 +821,7 @@ parse_exp (struct lexer *lexer, struct expression *e)
   int start_ofs = lex_ofs (lexer);
   struct expr_node *lhs = expr_allocate_number (e, -lex_tokval (lexer));
   lex_get (lexer);
+  expr_add_location (lexer, e, start_ofs, lhs);
 
   struct expr_node *node = parse_binary_operators__ (
     lexer, e, &op, 1, parse_primary, chain_warning, lhs);
@@ -974,23 +994,9 @@ parse_primary__ (struct lexer *lexer, struct expression *e)
 
     case T_LPAREN:
       {
-        /* Count number of left parentheses so that we can match them against
-           an equal number of right parentheses.  This defeats trivial attempts
-           to exhaust the stack with a lot of left parentheses.  (More
-           sophisticated attacks will still succeed.) */
-        size_t n = 0;
-        while (lex_match (lexer, T_LPAREN))
-          n++;
-
+        lex_get (lexer);
         struct expr_node *node = parse_or (lexer, e);
-       if (!node)
-          return NULL;
-
-        for (size_t i = 0; i < n; i++)
-          if (!lex_force_match (lexer, T_RPAREN))
-            return NULL;
-
-        return node;
+       return !node || !lex_force_match (lexer, T_RPAREN) ? NULL : node;
       }
 
     default:
@@ -1037,7 +1043,7 @@ parse_vector_element (struct lexer *lexer, struct expression *e)
     return NULL;
 
   operation_type type = (vector_get_type (vector) == VAL_NUMERIC
-                         ? OP_VEC_ELEM_NUM : OP_VEC_ELEM_STR);
+                         ? OP_VEC_ELEM_NUM_RAW : OP_VEC_ELEM_STR);
   struct expr_node *node = expr_allocate_binary (
     e, type, element, expr_allocate_vector (e, vector));
   expr_add_location (lexer, e, vector_start_ofs, node);
@@ -1262,16 +1268,15 @@ put_invocation (struct string *s,
 
 static void
 no_match (struct expression *e, const char *func_name, struct expr_node *node,
-          const struct operation *first, const struct operation *last)
+          const struct operation *ops, size_t n)
 {
   struct string s;
-  const struct operation *f;
 
   ds_init_empty (&s);
 
-  if (last - first == 1)
+  if (n == 1)
     {
-      ds_put_format (&s, _("Type mismatch invoking %s as "), first->prototype);
+      ds_put_format (&s, _("Type mismatch invoking %s as "), ops->prototype);
       put_invocation (&s, func_name, node);
     }
   else
@@ -1280,13 +1285,33 @@ no_match (struct expression *e, const char *func_name, struct expr_node *node,
       put_invocation (&s, func_name, node);
       ds_put_cstr (&s, _(" does not match any known function.  Candidates are:"));
 
-      for (f = first; f < last; f++)
-        ds_put_format (&s, "\n%s", f->prototype);
+      for (size_t i = 0; i < n; i++)
+        ds_put_format (&s, "\n%s", ops[i].prototype);
     }
   ds_put_byte (&s, '.');
 
   msg_at (SE, expr_location (e, node), "%s", ds_cstr (&s));
 
+  if (n == 1 && ops->n_args == node->n_args)
+    {
+      for (size_t i = 0; i < ops->n_args; i++)
+        if ((ops->args[i] == OP_ni_format
+             || ops->args[i] == OP_no_format)
+            && expr_node_returns (node->args[i]) == OP_format)
+          {
+            const struct fmt_spec *f = &node->args[i]->format;
+            char *error = fmt_check__ (f, (ops->args[i] == OP_ni_format
+                                           ? FMT_FOR_INPUT : FMT_FOR_OUTPUT));
+            if (!error)
+              error = fmt_check_type_compat__ (f, VAL_NUMERIC);
+            if (error)
+              {
+                msg_at (SN, expr_location (e, node->args[i]), "%s", error);
+                free (error);
+              }
+          }
+    }
+
   ds_destroy (&s);
 }
 
@@ -1360,7 +1385,7 @@ parse_function (struct lexer *lexer, struct expression *e)
   const struct operation *f = match_function (n, first, last);
   if (!f)
     {
-      no_match (e, ds_cstr (&func_name), n, first, last);
+      no_match (e, ds_cstr (&func_name), n, first, last - first);
       goto fail;
     }
   n->type = f - operations;
@@ -1562,6 +1587,15 @@ expr_allocate_format (struct expression *e, const struct fmt_spec *format)
   return n;
 }
 
+struct expr_node *
+expr_allocate_expr_node (struct expression *e,
+                         const struct expr_node *expr_node)
+{
+  struct expr_node *n = pool_alloc (e->expr_pool, sizeof *n);
+  *n = (struct expr_node) { .type = OP_expr_node, .expr_node = expr_node };
+  return n;
+}
+
 /* Allocates a unary composite node that represents the value of
    variable V in expression E. */
 static struct expr_node *