start updating expression tests
authorBen Pfaff <blp@cs.stanford.edu>
Wed, 22 Dec 2021 00:44:09 +0000 (16:44 -0800)
committerBen Pfaff <blp@cs.stanford.edu>
Wed, 22 Dec 2021 00:44:09 +0000 (16:44 -0800)
12 files changed:
src/data/calendar.c
src/data/calendar.h
src/data/dataset.c
src/language/expressions/evaluate.c
src/language/expressions/generate.py
src/language/expressions/helpers.c
src/language/expressions/helpers.h
src/language/expressions/operations.def
src/language/expressions/optimize.c
src/language/expressions/parse.c
src/language/expressions/private.h
tests/language/expressions/parse.at

index e07e7d63aca2e9043f7edf692c351147183137e4..d853be1a9bc892c76c34970ff1611aec80a59004 100644 (file)
@@ -54,8 +54,8 @@ is_leap_year (int y)
   return y % 4 == 0 && (y % 100 != 0 || y % 400 == 0);
 }
 
-static int
-raw_gregorian_to_offset (int y, int m, int d)
+int
+calendar_raw_gregorian_to_offset (int y, int m, int d)
 {
   return (EPOCH - 1
           + 365 * (y - 1)
@@ -67,66 +67,77 @@ raw_gregorian_to_offset (int y, int m, int d)
           + d);
 }
 
-/* Returns the number of days from 14 Oct 1582 to (Y,M,D) in the
-   Gregorian calendar.  Returns SYSMIS for dates before 14 Oct
-   1582. */
-double
-calendar_gregorian_to_offset (int y, int m, int d,
-                              const struct fmt_settings *settings,
-                              char **errorp)
+int *
+calendar_gregorian_adjust (int *y, int *m, int *d,
+                           const struct fmt_settings *settings)
 {
   /* Normalize year. */
-  if (y >= 0 && y < 100)
+  if (*y >= 0 && *y < 100)
     {
       int epoch = fmt_settings_get_epoch (settings);
-      int century = epoch / 100 + (y < epoch % 100);
-      y += century * 100;
+      int century = epoch / 100 + (*y < epoch % 100);
+      *y += century * 100;
     }
 
   /* Normalize month. */
-  if (m < 1 || m > 12)
+  if (*m < 1 || *m > 12)
     {
-      if (m == 0)
+      if (*m == 0)
         {
-          y--;
-          m = 12;
+          *y -= 1;
+          *m = 12;
         }
-      else if (m == 13)
+      else if (*m == 13)
         {
-          y++;
-          m = 1;
+          *y += 1;
+          *m = 1;
         }
       else
-        {
-          if (errorp != NULL)
-            *errorp = xasprintf (_("Month %d is not in acceptable range of "
-                                   "0 to 13."), m);
-          return SYSMIS;
-        }
+        return m;
     }
 
   /* Normalize day. */
-  if (d < 0 || d > 31)
-    {
-      if (errorp != NULL)
-        *errorp = xasprintf (_("Day %d is not in acceptable range of "
-                               "0 to 31."), d);
-      return SYSMIS;
-    }
+  if (*d < 0 || *d > 31)
+    return d;
 
   /* Validate date. */
-  if (y < 1582 || (y == 1582 && (m < 10 || (m == 10 && d < 15))))
+  if (*y < 1582 || (*y == 1582 && (*m < 10 || (*m == 10 && *d < 15))))
+    return y;
+
+  return NULL;
+}
+
+/* Returns the number of days from 14 Oct 1582 to (Y,M,D) in the
+   Gregorian calendar.  Returns SYSMIS for dates before 14 Oct
+   1582. */
+double
+calendar_gregorian_to_offset (int y, int m, int d,
+                              const struct fmt_settings *settings,
+                              char **errorp)
+{
+  int *bad_value = calendar_gregorian_adjust (&y, &m, &d, settings);
+  if (!bad_value)
+    {
+      if (errorp)
+        *errorp = NULL;
+      return calendar_raw_gregorian_to_offset (y, m, d);
+    }
+  else
     {
-      if (errorp != NULL)
-        *errorp = xasprintf (_("Date %04d-%d-%d is before the earliest "
-                               "acceptable date of 1582-10-15."), y, m, d);
+      if (errorp)
+        {
+          if (bad_value == &y)
+            *errorp = xasprintf (_("Date %04d-%d-%d is before the earliest "
+                                   "supported date 1582-10-15."), y, m, d);
+          else if (bad_value == &m)
+            *errorp = xasprintf (_("Month %d is not in acceptable range of "
+                                   "0 to 13."), m);
+          else
+            *errorp = xasprintf (_("Day %d is not in acceptable range of "
+                                   "0 to 31."), d);
+        }
       return SYSMIS;
     }
-
-  /* Calculate offset. */
-  if (errorp != NULL)
-    *errorp = NULL;
-  return raw_gregorian_to_offset (y, m, d);
 }
 
 /* Returns the number of days in the given YEAR from January 1 up
@@ -187,7 +198,7 @@ void
 calendar_offset_to_gregorian (int ofs, int *y, int *m, int *d, int *yd)
 {
   int year = *y = calendar_offset_to_year (ofs);
-  int january1 = raw_gregorian_to_offset (year, 1, 1);
+  int january1 = calendar_raw_gregorian_to_offset (year, 1, 1);
   int yday = *yd = ofs - january1 + 1;
   int march1 = january1 + cum_month_days (year, 3);
   int correction = ofs < march1 ? 0 : (is_leap_year (year) ? 1 : 2);
@@ -202,7 +213,7 @@ int
 calendar_offset_to_yday (int ofs)
 {
   int year = calendar_offset_to_year (ofs);
-  int january1 = raw_gregorian_to_offset (year, 1, 1);
+  int january1 = calendar_raw_gregorian_to_offset (year, 1, 1);
   int yday = ofs - january1 + 1;
   return yday;
 }
index 02a9de28ace572aa9ddf5923e8fb61cdf8fcb85a..ce3fcc2ee352f73193a44895fcaa70d63548a98e 100644 (file)
@@ -21,9 +21,14 @@ along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 struct fmt_settings;
 
+int *calendar_gregorian_adjust (int *y, int *m, int *d,
+                                const struct fmt_settings *);
+int calendar_raw_gregorian_to_offset (int y, int m, int d);
+
 double calendar_gregorian_to_offset (int y, int m, int d,
                                      const struct fmt_settings *,
                                      char **errorp);
+
 void calendar_offset_to_gregorian (int ofs, int *y, int *m, int *d, int *yd);
 int calendar_offset_to_year (int ofs);
 int calendar_offset_to_month (int ofs);
index 648e00f04ee1c094ea7a60bf8068b3f60452f0c0..e11f173948cc0ec1293ffa5f6800a8702e69e074 100644 (file)
@@ -376,6 +376,8 @@ dataset_set_display (struct dataset *ds, enum dataset_display display)
 time_t
 time_of_last_procedure (struct dataset *ds)
 {
+  if (!ds)
+    return time (NULL);
   if (ds->last_proc_invocation == 0)
     update_last_proc_invocation (ds);
   return ds->last_proc_invocation;
index 1ad2be802e437eadd50a481f0ae0499c5d5b6a83..10d239841e2a5371f7c5d36dda4c42f0639014dd 100644 (file)
@@ -16,6 +16,7 @@
 
 #include <config.h>
 
+#include "language/expressions/private.h"
 #include "evaluate.h"
 
 #include <ctype.h>
@@ -23,7 +24,6 @@
 #include "libpspp/assertion.h"
 #include "libpspp/message.h"
 #include "language/expressions/helpers.h"
-#include "language/expressions/private.h"
 #include "language/lexer/value-parser.h"
 #include "libpspp/pool.h"
 #include "output/driver.h"
@@ -120,6 +120,7 @@ cmd_debug_evaluate (struct lexer *lexer, struct dataset *dsother UNUSED)
   struct dataset *ds = NULL;
 
   char *name = NULL;
+  char *title = NULL;
 
   struct expression *expr;
 
@@ -184,14 +185,21 @@ cmd_debug_evaluate (struct lexer *lexer, struct dataset *dsother UNUSED)
     }
 
   if (!lex_force_match (lexer, T_SLASH))
-      goto done;
+    goto done;
+
+  for (size_t i = 1; ; i++)
+    if (lex_next_token (lexer, i) == T_ENDCMD)
+      {
+        title = lex_next_representation (lexer, 0, i - 1);
+        break;
+      }
 
   expr = expr_parse_any (lexer, ds, optimize);
   if (!expr || lex_end_of_command (lexer) != CMD_SUCCESS)
     {
       if (expr != NULL)
         expr_free (expr);
-      output_log ("error");
+      output_log ("%s => error", title);
       goto done;
     }
 
@@ -204,16 +212,16 @@ cmd_debug_evaluate (struct lexer *lexer, struct dataset *dsother UNUSED)
         {
           double d = expr_evaluate_num (expr, c, 0);
           if (d == SYSMIS)
-            output_log ("sysmis");
+            output_log ("%s => sysmis", title);
           else
-            output_log ("%.2f", d);
+            output_log ("%s => %.2f", title, d);
         }
         break;
 
       case OP_boolean:
         {
           double b = expr_evaluate_num (expr, c, 0);
-          output_log ("%s",
+          output_log ("%s => %s", title,
                       b == SYSMIS ? "sysmis" : b == 0.0 ? "false" : "true");
         }
         break;
@@ -222,7 +230,7 @@ cmd_debug_evaluate (struct lexer *lexer, struct dataset *dsother UNUSED)
         {
           struct substring out;
           expr_evaluate (expr, c, 0, &out);
-          output_log ("\"%.*s\"", (int) out.length, out.string);
+          output_log ("%s => \"%.*s\"", title, (int) out.length, out.string);
           break;
         }
 
@@ -239,6 +247,7 @@ cmd_debug_evaluate (struct lexer *lexer, struct dataset *dsother UNUSED)
   case_unref (c);
 
   free (name);
+  free (title);
 
   return retval;
 }
@@ -294,6 +303,9 @@ expr_debug_print_postfix (const struct expression *e)
         case OP_integer:
           ds_put_format (&s, "i<%d>", op->integer);
           break;
+        case OP_exprnode:
+          ds_put_cstr (&s, "expr_node");
+          break;
         default:
           NOT_REACHED ();
         }
index e530cd8208a11542c71e62f364e98890258aa974..ed041f7efd1699fc9e74fe36c1a397053a4499ae 100644 (file)
@@ -46,6 +46,8 @@ def init_all_types():
                      'string', 'ss', 'empty_string'),
         Type.new_any('boolean', 'double', 'number', 'n',
                      'boolean', 'ns', 'SYSMIS'),
+        Type.new_any('integer', 'int', 'number', 'n',
+                     'integer', 'ns', 'SYSMIS'),
 
         # Format types.
         Type.new_atom('format'),
@@ -55,8 +57,6 @@ def init_all_types():
                       'format', 'f', 'num_output_format'),
 
         # Integer types.
-        Type.new_leaf('integer', 'int', 'integer', 'n',
-                      'integer'),
         Type.new_leaf('pos_int', 'int', 'integer', 'n',
                       'positive_integer_constant'),
 
@@ -75,6 +75,7 @@ def init_all_types():
 
         # Types that appear only as auxiliary data.
         Type.new_auxonly('expression', 'struct expression *', 'e'),
+        Type.new_auxonly('expr_node', 'const struct expr_node *', 'n'),
         Type.new_auxonly('case', 'const struct ccase *', 'c'),
         Type.new_auxonly('case_idx', 'size_t', 'case_idx'),
         Type.new_auxonly('dataset', 'struct dataset *', 'ds'),
@@ -87,6 +88,7 @@ def init_all_types():
 
         # Used only for debugging purposes.
         Type.new_atom('operation'),
+        Type.new_atom('exprnode'),
     ]:
         types[t.name] = t
 
@@ -313,6 +315,10 @@ class Op:
             flags += ['OPF_PERM_ONLY']
         if self.no_abbrev:
             flags += ['OPF_NO_ABBREV']
+        for aux in self.aux:
+            if aux['TYPE'].name == 'expr_node':
+                flags += ['OPF_EXPR_NODE']
+                break
         return ' | '.join(flags) if flags else '0'
 
 
@@ -755,6 +761,10 @@ def generate_evaluate_inc():
                 decls += ['%saux_%s = op++->%s'
                           % (type_.c_type, name, type_.atom)]
                 args += ['aux_%s' % name]
+            elif type_.name == 'expr_node':
+                decls += ['%saux_%s = op++->node'
+                          % (type_.c_type, name)]
+                args += ['aux_%s' % name]
             elif type_.role == 'auxonly':
                 args += [type_.auxonly_value]
 
@@ -884,6 +894,8 @@ def generate_optimize_inc():
                 func = 'get_%s_arg' % type_.atom
                 args += '%s (node, %s)' % (func, arg_idx)
                 arg_idx += 1
+            elif type_.name == 'expr_node':
+                args += ['node']
             elif type_.role == 'auxonly':
                 args += [type_.auxonly_value]
             else:
index 053ada56b555b5215d40b61eddbb7e0f9cf5dea0..d23e7fe82b0811773b5a99e378f9986bc3fa393c 100644 (file)
@@ -1,6 +1,6 @@
 /* PSPP - a program for statistical analysis.
    Copyright (C) 2008, 2010, 2011, 2015, 2016 Free Software Foundation, Inc.
-
+   
    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
 const struct substring empty_string = {NULL, 0};
 
 double
-expr_ymd_to_ofs (double year, double month, double day)
-{
-  int y = year;
-  int m = month;
-  int d = day;
-  char *error;
-  double ofs;
-
-  if (y != year || m != month || d != day)
-    {
-      msg (SE, _("One of the arguments to a DATE function is not an integer.  "
-                 "The result will be system-missing."));
-      return SYSMIS;
-    }
-
-  ofs = calendar_gregorian_to_offset (y, m, d, settings_get_fmt_settings (),
-                                      &error);
-  if (error != NULL)
-    {
-      msg (SE, "%s", error);
-      free (error);
-    }
-  return ofs;
-}
-
-double
-expr_ymd_to_date (double year, double month, double day)
-{
-  double ofs = expr_ymd_to_ofs (year, month, day);
-  return ofs != SYSMIS ? ofs * DAY_S : SYSMIS;
-}
-
-double
-expr_wkyr_to_date (double week, double year)
+expr_ymd_to_ofs (int y, int m, int d,
+                 const struct expression *e, const struct expr_node *node,
+                 int ya, int ma, int da)
 {
-  int w = week;
-
-  if (w != week)
-    {
-      msg (SE, _("The week argument to DATE.WKYR is not an integer.  "
-                 "The result will be system-missing."));
-      return SYSMIS;
-    }
-  else if (w < 1 || w > 53)
-    {
-      msg (SE, _("The week argument to DATE.WKYR is outside the acceptable "
-                 "range of 1 to 53.  "
-                 "The result will be system-missing."));
-      return SYSMIS;
-    }
+  int *error = calendar_gregorian_adjust (&y, &m, &d,
+                                          settings_get_fmt_settings ());
+  if (!error)
+    return calendar_raw_gregorian_to_offset (y, m, d);
   else
     {
-      double yr_1_1 = expr_ymd_to_ofs (year, 1, 1);
-      if (yr_1_1 != SYSMIS)
-        return DAY_S * (yr_1_1 + WEEK_DAY * (w - 1));
-      else
-        return SYSMIS;
-    }
-}
-
-double
-expr_yrday_to_date (double year, double yday)
-{
-  int yd = yday;
-
-  if (yd != yday)
-    {
-      msg (SE, _("The day argument to DATE.YRDAY is not an integer.  "
-                 "The result will be system-missing."));
-      return SYSMIS;
-    }
-  else if (yd < 1 || yd > 366)
-    {
-      msg (SE, _("The day argument to DATE.YRDAY is outside the acceptable "
-                 "range of 1 to 366.  "
-                 "The result will be system-missing."));
+      msg_at (SE, expr_location (e, node),
+              _("Invalid arguments to %s function."),
+              operations[node->type].name);
+
+      if (error == &y && ya > 0)
+        msg_at (SN, expr_location (e, y < 1582 ? node->args[ya - 1] : node),
+                _("Date %04d-%d-%d is before the earliest supporte date "
+                  "1582-10-15."), y, m, d);
+      else if (error == &m && ma > 0)
+        msg_at (SN, expr_location (e, node->args[ma - 1]),
+                _("Month %d is not in acceptable range of 0 to 13."), m);
+      else if (error == &d && da > 0)
+        msg_at (SN, expr_location (e, node->args[da - 1]),
+                _("Day %d is not in acceptable range of 0 to 31."), d);
       return SYSMIS;
     }
-  else
-    {
-      double yr_1_1 = expr_ymd_to_ofs (year, 1, 1);
-      if (yr_1_1 != SYSMIS)
-        return DAY_S * (yr_1_1 + yd - 1.);
-      else
-        return SYSMIS;
-    }
 }
 
 double
-expr_yrmoda (double year, double month, double day)
+expr_ymd_to_date (int y, int m, int d,
+                  const struct expression *e, const struct expr_node *n,
+                  int ya, int ma, int da)
 {
-  if (year >= 0 && year <= 99)
-    year += 1900;
-  else if (year != (int) year && year > 47516)
-    {
-      msg (SE, _("The year argument to YRMODA is greater than 47516.  "
-                 "The result will be system-missing."));
-      return SYSMIS;
-    }
-
-  return expr_ymd_to_ofs (year, month, day);
+  double ofs = expr_ymd_to_ofs (y, m, d, e, n, ya, ma, da);
+  return ofs != SYSMIS ? ofs * DAY_S : SYSMIS;
 }
 \f
 /* A date unit. */
@@ -149,7 +83,8 @@ enum date_unit
 /* Stores in *UNIT the unit whose name is NAME.
    Return success. */
 static enum date_unit
-recognize_unit (struct substring name, enum date_unit *unit)
+recognize_unit (struct substring name, const struct expression *e,
+                const struct expr_node *n, enum date_unit *unit)
 {
   struct unit_name
     {
@@ -178,12 +113,13 @@ recognize_unit (struct substring name, enum date_unit *unit)
         return true;
       }
 
-  msg (SE, _("Unrecognized date unit `%.*s'.  "
-             "Valid date units are `%s', `%s', `%s', "
-             "`%s', `%s', `%s', `%s', and `%s'."),
-       (int) ss_length (name), ss_data (name),
-       "years", "quarters", "months",
-       "weeks", "days", "hours", "minutes", "seconds");
+  msg_at (SE, expr_location (e, n),
+          _("Unrecognized date unit `%.*s'.  "
+            "Valid date units are `%s', `%s', `%s', "
+            "`%s', `%s', `%s', `%s', and `%s'."),
+          (int) ss_length (name), ss_data (name),
+          "years", "quarters", "months",
+          "weeks", "days", "hours", "minutes", "seconds");
 
   return false;
 }
@@ -272,11 +208,11 @@ date_unit_duration (enum date_unit unit)
 
 /* Returns the span from DATE1 to DATE2 in terms of UNIT_NAME. */
 double
-expr_date_difference (double date1, double date2, struct substring unit_name)
+expr_date_difference (double date1, double date2, struct substring unit_name,
+                      const struct expression *e, const struct expr_node *n)
 {
   enum date_unit unit;
-
-  if (!recognize_unit (unit_name, &unit))
+  if (!recognize_unit (unit_name, e, n->args[2], &unit))
     return SYSMIS;
 
   switch (unit)
@@ -317,7 +253,9 @@ enum date_sum_method
 /* Stores in *METHOD the method whose name is NAME.
    Return success. */
 static bool
-recognize_method (struct substring method_name, enum date_sum_method *method)
+recognize_method (struct substring method_name,
+                  const struct expression *e, const struct expr_node *n,
+                  enum date_sum_method *method)
 {
   if (ss_equals_case (method_name, ss_cstr ("closest")))
     {
@@ -331,8 +269,9 @@ recognize_method (struct substring method_name, enum date_sum_method *method)
     }
   else
     {
-      msg (SE, _("Invalid DATESUM method.  "
-                 "Valid choices are `%s' and `%s'."), "closest", "rollover");
+      msg_at (SE, expr_location (e, n),
+              _("Invalid DATESUM method.  "
+                "Valid choices are `%s' and `%s'."), "closest", "rollover");
       return false;
     }
 }
@@ -340,7 +279,8 @@ recognize_method (struct substring method_name, enum date_sum_method *method)
 /* Returns DATE advanced by the given number of MONTHS, with
    day-of-month overflow resolved using METHOD. */
 static double
-add_months (double date, int months, enum date_sum_method method)
+add_months (double date, int months, enum date_sum_method method,
+            const struct expression *e, const struct expr_node *n)
 {
   int y, m, d, yd;
   double output;
@@ -370,7 +310,7 @@ add_months (double date, int months, enum date_sum_method method)
     output = (output * DAY_S) + fmod (date, DAY_S);
   else
     {
-      msg (SE, "%s", error);
+      msg_at (SE, expr_location (e, n), "%s", error);
       free (error);
     }
   return output;
@@ -379,27 +319,25 @@ add_months (double date, int months, enum date_sum_method method)
 /* Returns DATE advanced by the given QUANTITY of units given in
    UNIT_NAME, with day-of-month overflow resolved using
    METHOD_NAME. */
-double
-expr_date_sum (double date, double quantity, struct substring unit_name,
-               struct substring method_name)
+static double
+expr_date_sum__ (double date, double quantity, struct substring unit_name,
+                 enum date_sum_method method,
+                 const struct expression *e, const struct expr_node *n)
 {
   enum date_unit unit;
-  enum date_sum_method method;
-
-  if (!recognize_unit (unit_name, &unit)
-      || !recognize_method (method_name, &method))
+  if (!recognize_unit (unit_name, e, n->args[2], &unit))
     return SYSMIS;
 
   switch (unit)
     {
     case DATE_YEARS:
-      return add_months (date, trunc (quantity) * 12, method);
+      return add_months (date, trunc (quantity) * 12, method, e, n);
 
     case DATE_QUARTERS:
-      return add_months (date, trunc (quantity) * 3, method);
+      return add_months (date, trunc (quantity) * 3, method, e, n);
 
     case DATE_MONTHS:
-      return add_months (date, trunc (quantity), method);
+      return add_months (date, trunc (quantity), method, e, n);
 
     case DATE_WEEKS:
     case DATE_DAYS:
@@ -412,6 +350,31 @@ expr_date_sum (double date, double quantity, struct substring unit_name,
   NOT_REACHED ();
 }
 
+/* Returns DATE advanced by the given QUANTITY of units given in
+   UNIT_NAME, with day-of-month overflow resolved using
+   METHOD_NAME. */
+double
+expr_date_sum (double date, double quantity, struct substring unit_name,
+               struct substring method_name,
+               const struct expression *e, const struct expr_node *n)
+{
+  enum date_sum_method method;
+  if (!recognize_method (method_name, e, n->args[3], &method))
+    return SYSMIS;
+
+  return expr_date_sum__ (date, quantity, unit_name, method, e, n);
+}
+
+/* Returns DATE advanced by the given QUANTITY of units given in
+   UNIT_NAME, with day-of-month overflow resolved using
+   METHOD_NAME. */
+double
+expr_date_sum_closest (double date, double quantity, struct substring unit_name,
+                       const struct expression *e, const struct expr_node *n)
+{
+  return expr_date_sum__ (date, quantity, unit_name, SUM_CLOSEST, e, n);
+}
+
 int
 compare_string_3way (const struct substring *a, const struct substring *b)
 {
index 1bd0ac8cb87dae0ab7c39bf357dc741e8ce10418..69c5ad348ddac45ca01b4e38053653bdd7afce69 100644 (file)
@@ -51,6 +51,8 @@ along with this program.  If not, see <http://www.gnu.org/licenses/>.
 #include "gettext.h"
 #define _(msgid) gettext (msgid)
 
+struct expr_node;
+
 static inline double check_errno (double x)
 {
   return errno == 0 ? x : SYSMIS;
@@ -70,15 +72,22 @@ extern const struct substring empty_string;
 
 int compare_string_3way (const struct substring *, const struct substring *);
 
-double expr_ymd_to_date (double year, double month, double day);
-double expr_ymd_to_ofs (double year, double month, double day);
-double expr_wkyr_to_date (double wk, double yr);
-double expr_yrday_to_date (double yr, double day);
-double expr_yrmoda (double year, double month, double day);
+double expr_ymd_to_date (int year, int month, int day,
+                         const struct expression *, const struct expr_node *,
+                         int ya, int ma, int da);
+double expr_ymd_to_ofs (int y, int m, int d,
+                        const struct expression *, const struct expr_node *,
+                        int ya, int ma, int da);
 double expr_date_difference (double date1, double date2,
-                             struct substring unit);
+                             struct substring unit, const struct expression *,
+                             const struct expr_node *);
 double expr_date_sum (double date, double quantity, struct substring unit_name,
-                      struct substring method_name);
+                      struct substring method_name,
+                      const struct expression *, const struct expr_node *);
+double expr_date_sum_closest (double date, double quantity,
+                              struct substring unit_name,
+                              const struct expression *,
+                              const struct expr_node *);
 
 struct substring alloc_string (struct expression *, size_t length);
 struct substring copy_string (struct expression *,
index cc24f98751ef84db7861baadaef01e90b33321d9..cbdc247c56162ee75738d6a2a751f21f517f11eb 100644 (file)
@@ -277,10 +277,22 @@ function VARIANCE.2 (a[n])
 
 // Time construction & extraction functions.
 function TIME.HMS (h, m, s)
+  expression e;
+  expr_node n;
 {
   if ((h > 0. || m > 0. || s > 0.) && (h < 0. || m < 0. || s < 0.))
     {
-      msg (SW, _("TIME.HMS cannot mix positive and negative arguments."));
+      msg_at (SW, expr_location (e, n),
+              _("TIME.HMS cannot accept a mix of positive and negative "
+                "arguments."));
+      double args[] = { h, m, s };
+      for (size_t i = 0; i < 3; i++)
+        if (args[i] > 0)
+          msg_at (SN, expr_location (e, n->args[i]),
+                  _("This argument has positive value %g."), args[i]);
+        else if (args[i] < 0)
+          msg_at (SN, expr_location (e, n->args[i]),
+                  _("This argument has negative value %g."), args[i]);
       return SYSMIS;
     }
   else
@@ -293,21 +305,92 @@ function CTIME.MINUTES (time) = time / MIN_S;
 function CTIME.SECONDS (time) = time;
 
 // Date construction functions.
-function DATE.DMY (d, m, y) = expr_ymd_to_date (y, m, d);
-function DATE.MDY (m, d, y) = expr_ymd_to_date (y, m, d);
-function DATE.MOYR (m, y) = expr_ymd_to_date (y, m, 1);
-function DATE.QYR (q, y)
+function DATE.DMY (integer d, integer m, integer y)
+  expression e;
+  expr_node n;
+= expr_ymd_to_date (y, m, d, e, n, 3, 2, 1);
+
+function DATE.MDY (integer m, integer d, integer y)
+  expression e;
+  expr_node n;
+= expr_ymd_to_date (y, m, d, e, n, 3, 1, 2);
+
+function DATE.MOYR (integer m, integer y)
+  expression e;
+  expr_node n;
+= expr_ymd_to_date (y, m, 1, e, n, 2, 1, 0);
+
+function DATE.QYR (integer q, integer y)
+  expression e;
+  expr_node n;
 {
-  if (q < 1.0 || q > 4.0 || q != (int) q)
+  if (q < 1 || q > 4)
     {
-      msg (SW, _("The first argument to DATE.QYR must be 1, 2, 3, or 4."));
+      msg_at (SW, expr_location (e, n->args[0]),
+              _("Argument 1 to DATE.QYR must be 1, 2, 3, or 4 (not %d)."), q);
       return SYSMIS;
     }
-   return expr_ymd_to_date (y, q * 3 - 2, 1);
+  return expr_ymd_to_date (y, q * 3 - 2, 1, e, n, 2, 0, 0);
+}
+
+function DATE.WKYR (integer w, integer y)
+  expression e;
+  expr_node n;
+{
+  if (w < 1 || w > 53)
+    {
+      msg_at (SE, expr_location (e, n->args[0]),
+              _("The week argument to DATE.WKYR is outside the acceptable "
+                "range of 1 to 53.  The result will be system-missing."));
+      return SYSMIS;
+    }
+  else
+    {
+      double yr_1_1 = expr_ymd_to_ofs (y, 1, 1, e, n, 2, 0, 0);
+      if (yr_1_1 != SYSMIS)
+        return DAY_S * (yr_1_1 + WEEK_DAY * (w - 1));
+      else
+        return SYSMIS;
+    }
+}
+
+function DATE.YRDAY (integer y, integer yd)
+  expression e;
+  expr_node n;
+{
+  if (yd < 1 || yd > 366)
+    {
+      msg_at (SE, expr_location (e, n->args[1]),
+              _("DATE.YRDAY day argument %d is outside the acceptable "
+                "range of 1 to 366.  The result will be system-missing."), yd);
+      return SYSMIS;
+    }
+  else
+    {
+      double yr_1_1 = expr_ymd_to_ofs (y, 1, 1, e, n, 1, 0, 0);
+      if (yr_1_1 != SYSMIS)
+        return DAY_S * (yr_1_1 + yd - 1.);
+      else
+        return SYSMIS;
+    }
+}
+
+function YRMODA (integer y, integer m, integer d)
+  expression e;
+  expr_node n;
+{
+  if (y >= 0 && y <= 99)
+    y += 1900;
+  else if (y > 47516)
+    {
+      msg_at (SE, expr_location (e, n->args[0]),
+              _("The year argument to YRMODA is greater than 47516.  "
+                "The result will be system-missing."));
+      return SYSMIS;
+    }
+
+  return expr_ymd_to_ofs (y, m, d, e, n, 1, 2, 3);
 }
-function DATE.WKYR (w, y) = expr_wkyr_to_date (w, y);
-function DATE.YRDAY (y, yday) = expr_yrday_to_date (y, yday);
-function YRMODA (y, m, d) = expr_yrmoda (y, m, d);
 
 // Date extraction functions.
 function XDATE.TDAY (date) = floor (date / DAY_S);
@@ -330,11 +413,18 @@ function XDATE.YEAR (date >= DAY_S) = calendar_offset_to_year (date / DAY_S);
 
 // Date arithmetic functions.
 no_abbrev function DATEDIFF (date2 >= DAY_S, date1 >= DAY_S, string unit)
-     = expr_date_difference (date1, date2, unit);
+  expression e;
+  expr_node n;
+= expr_date_difference (date1, date2, unit, e, n);
+
 no_abbrev function DATESUM (date, quantity, string unit)
-     = expr_date_sum (date, quantity, unit, ss_cstr ("closest"));
+  expression e;
+  expr_node n;
+= expr_date_sum_closest (date, quantity, unit, e, n);
 no_abbrev function DATESUM (date, quantity, string unit, string method)
-     = expr_date_sum (date, quantity, unit, method);
+  expression e;
+  expr_node n;
+= expr_date_sum (date, quantity, unit, method, e, n);
 
 
 // String functions.
@@ -592,6 +682,8 @@ string function RTRIM (string s, string c)
 }
 
 function NUMBER (string s, ni_format f)
+  expression e;
+  expr_node n;
 {
   union value out;
   char *error;
@@ -605,8 +697,9 @@ function NUMBER (string s, ni_format f)
                             settings_get_fmt_settings (), &out);
   else
     {
-      msg (SE, "Cannot parse `%.*s' as format %s: %s",
-           (int) s.length, s.string, fmt_name (f->type), error);
+      msg_at (SE, expr_location (e, n->args[0]),
+              _("Cannot parse `%.*s' as format %s: %s"),
+              (int) s.length, s.string, fmt_name (f->type), error);
       free (error);
     }
   return out.f;
@@ -677,17 +770,31 @@ absorb_miss no_opt no_abbrev string function VALUELABEL (var v)
 
 // Artificial.
 operator SQUARE (x) = x * x;
-boolean operator NUM_TO_BOOLEAN (x)
+absorb_miss boolean operator NUM_TO_BOOLEAN (x)
+  expression e;
+  expr_node n;
 {
   if (x == 0. || x == 1. || x == SYSMIS)
     return x;
 
-  msg (SE, _("A logical expression was found to have a value other than 0 "
-             "(false), 1 (true), or the system-missing value.  The result "
-             "was forced to 0."));
+  msg_at (SE, expr_location (e, n),
+          _("This logical expression must evaluate to 0 or 1.  "
+            "Treating unexpected value %g as 0."), x);
   return 0.;
 }
 
+operator NUM_TO_INTEGER (x)
+  expression e;
+  expr_node n;
+{
+  if (x == floor (x) && x > INT_MIN && x <= INT_MAX)
+    return x;
+
+  msg_at (SE, expr_location (e, n),
+          _("Treating unexpected non-integer value %g as missing."), x);
+  return SYSMIS;
+}
+
 operator BOOLEAN_TO_NUM (boolean x) = x;
 
 // Beta distribution.
@@ -968,6 +1075,8 @@ no_opt boolean function VALUE (num_var v)
 no_opt operator VEC_ELEM_NUM (idx)
      vector v;
      case c;
+     expression e;
+     expr_node n;
 {
   if (idx >= 1 && idx <= vector_get_n_vars (v))
     {
@@ -978,13 +1087,15 @@ no_opt operator VEC_ELEM_NUM (idx)
   else
     {
       if (idx == SYSMIS)
-        msg (SE, _("SYSMIS is not a valid index value for vector "
+        msg_at (SE, expr_location (e, n->args[0]),
+                _("SYSMIS is not a valid index value for %zu-element vector "
                    "%s.  The result will be set to SYSMIS."),
-             vector_get_name (v));
+                vector_get_n_vars (v), vector_get_name (v));
       else
-        msg (SE, _("%g is not a valid index value for vector %s.  "
-                   "The result will be set to SYSMIS."),
-             idx, vector_get_name (v));
+        msg_at (SE, expr_location (e, n->args[0]),
+                _("%g is not a valid index value for %zu-element vector %s.  "
+                  "The result will be set to SYSMIS."),
+                idx, vector_get_n_vars (v), vector_get_name (v));
       return SYSMIS;
     }
 }
@@ -993,6 +1104,7 @@ absorb_miss no_opt string operator VEC_ELEM_STR (idx)
      expression e;
      vector v;
      case c;
+     expr_node n;
 {
   if (idx >= 1 && idx <= vector_get_n_vars (v))
     {
@@ -1003,13 +1115,15 @@ absorb_miss no_opt string operator VEC_ELEM_STR (idx)
   else
     {
       if (idx == SYSMIS)
-        msg (SE, _("SYSMIS is not a valid index value for vector "
+        msg_at (SE, expr_location (e, n->args[0]),
+                _("SYSMIS is not a valid index value for %zu-element vector "
                    "%s.  The result will be set to the empty string."),
-             vector_get_name (v));
+                vector_get_n_vars (v), vector_get_name (v));
       else
-        msg (SE, _("%g is not a valid index value for vector %s.  "
-                   "The result will be set to the empty string."),
-             idx, vector_get_name (v));
+        msg_at (SE, expr_location (e, n->args[0]),
+                _("%g is not a valid index value for %zu-element vector %s.  "
+                  "The result will be set to the empty string."),
+                idx, vector_get_n_vars (v), vector_get_name (v));
       return empty_string;
     }
 }
index ea631a975c4af3fd582523e74d235594f2399445..30c3a89a1031b87d6b28e9ba55e1040bdc347c48 100644 (file)
@@ -135,38 +135,13 @@ optimize_tree (struct expr_node *n, struct expression *e)
     return n;
 }
 
-static double get_number_arg (struct expr_node *, size_t arg_idx);
-static double *get_number_args (struct expr_node *,
-                                 size_t arg_idx, size_t n_args,
-                                 struct expression *);
-static struct substring get_string_arg (struct expr_node *,
-                                           size_t arg_idx);
-static struct substring *get_string_args (struct expr_node *,
-                                             size_t arg_idx, size_t n_args,
-                                             struct expression *);
-static const struct fmt_spec *get_format_arg (struct expr_node *,
-                                              size_t arg_idx);
-
-static struct expr_node *
-evaluate_tree (struct expr_node *node, struct expression *e)
-{
-  switch (node->type)
-    {
-#include "optimize.inc"
-
-    default:
-      NOT_REACHED ();
-    }
-
-  NOT_REACHED ();
-}
-
 static double
 get_number_arg (struct expr_node *n, size_t arg_idx)
 {
   assert (arg_idx < n->n_args);
   assert (n->args[arg_idx]->type == OP_number
-          || n->args[arg_idx]->type == OP_boolean);
+          || n->args[arg_idx]->type == OP_boolean
+          || n->args[arg_idx]->type == OP_integer);
   return n->args[arg_idx]->number;
 }
 
@@ -209,6 +184,20 @@ get_format_arg (struct expr_node *n, size_t arg_idx)
           || n->args[arg_idx]->type == OP_no_format);
   return &n->args[arg_idx]->format;
 }
+
+static struct expr_node *
+evaluate_tree (struct expr_node *node, struct expression *e)
+{
+  switch (node->type)
+    {
+#include "optimize.inc"
+
+    default:
+      NOT_REACHED ();
+    }
+
+  NOT_REACHED ();
+}
 \f
 /* Expression flattening. */
 
@@ -344,6 +333,8 @@ flatten_composite (struct expr_node *n, struct expression *e)
     emit_integer (e, n->n_args - op->n_args + 1);
   if (op->flags & OPF_MIN_VALID)
     emit_integer (e, n->min_valid);
+  if (op->flags & OPF_EXPR_NODE)
+    allocate_aux (e, OP_exprnode)->node = n;
 }
 
 void
index 2b78b0b14b41491cc172fc301ac4476fdf0765ba..7eccdac2b12810b28b29bd5d8aa9c7016a47fa08 100644 (file)
@@ -60,7 +60,8 @@ atom_type expr_node_returns (const struct expr_node *);
 static const char *atom_type_name (atom_type);
 static struct expression *finish_expression (struct expr_node *,
                                              struct expression *);
-static bool type_check (const struct expr_node *, enum val_type expected_type);
+static bool type_check (const struct expression *, const struct expr_node *,
+                        enum val_type expected_type);
 static struct expr_node *allocate_unary_variable (struct expression *,
                                                 const struct variable *);
 \f
@@ -77,7 +78,7 @@ expr_parse (struct lexer *lexer, struct dataset *ds, enum val_type type)
 
   struct expression *e = expr_create (ds);
   struct expr_node *n = parse_or (lexer, e);
-  if (!n || !type_check (n, type))
+  if (!n || !type_check (e, n, type))
     {
       expr_free (e);
       return NULL;
@@ -103,7 +104,8 @@ expr_parse_bool (struct lexer *lexer, struct dataset *ds)
     n = expr_allocate_unary (e, OP_NUM_TO_BOOLEAN, n);
   else if (actual_type != OP_boolean)
     {
-      msg (SE, _("Type mismatch: expression has %s type, "
+      msg_at (SE, expr_location (e, n),
+              _("Type mismatch: expression has %s type, "
                  "but a boolean value is required here."),
            atom_type_name (actual_type));
       expr_free (e);
@@ -284,7 +286,8 @@ finish_expression (struct expr_node *n, struct expression *e)
    converted to type EXPECTED_TYPE, inserting a conversion at *N
    if necessary.  Returns true if successful, false on failure. */
 static bool
-type_check (const struct expr_node *n, enum val_type expected_type)
+type_check (const struct expression *e, const struct expr_node *n,
+            enum val_type expected_type)
 {
   atom_type actual_type = expr_node_returns (n);
 
@@ -293,8 +296,9 @@ type_check (const struct expr_node *n, enum val_type expected_type)
     case VAL_NUMERIC:
       if (actual_type != OP_number && actual_type != OP_boolean)
        {
-         msg (SE, _("Type mismatch: expression has %s type, "
-                     "but a numeric value is required here."),
+         msg_at (SE, expr_location (e, n),
+                  _("Type mismatch: expression has type '%s', "
+                     "but a numeric value is required."),
                atom_type_name (actual_type));
          return false;
        }
@@ -303,8 +307,9 @@ type_check (const struct expr_node *n, enum val_type expected_type)
     case VAL_STRING:
       if (actual_type != OP_string)
         {
-          msg (SE, _("Type mismatch: expression has %s type, "
-                     "but a string value is required here."),
+          msg_at (SE, expr_location (e, n),
+                  _("Type mismatch: expression has type '%s', "
+                     "but a string value is required."),
                atom_type_name (actual_type));
           return false;
         }
@@ -361,8 +366,8 @@ expr_location__ (struct expression *e,
 
 /* Returns the source code location corresponding to expression NODE, computing
    it lazily if needed. */
-static const struct msg_location *
-expr_location (struct expression *e, const struct expr_node *node_)
+const struct msg_location *
+expr_location (const struct expression *e_, const struct expr_node *node_)
 {
   struct expr_node *node = CONST_CAST (struct expr_node *, node_);
   if (!node)
@@ -370,6 +375,7 @@ expr_location (struct expression *e, const struct expr_node *node_)
 
   if (!node->location)
     {
+      struct expression *e = CONST_CAST (struct expression *, e_);
       const struct msg_location *min = NULL;
       const struct msg_location *max = NULL;
       expr_location__ (e, node, &min, &max);
@@ -448,6 +454,16 @@ type_coercion__ (struct expression *e, struct expr_node *node, size_t arg_idx,
         }
       break;
 
+    case OP_integer:
+      if (actual_type == OP_number)
+        {
+          /* Convert number to integer. */
+          if (do_coercion)
+            *argp = expr_allocate_unary (e, OP_NUM_TO_INTEGER, arg);
+          return true;
+        }
+      break;
+
     case OP_format:
       NOT_REACHED ();
 
@@ -772,9 +788,8 @@ parse_exp (struct lexer *lexer, struct expression *e)
   static const struct operator op = { .token = T_EXP, .num_op = OP_POW };
 
   const char *chain_warning =
-    _("The exponentiation operator (`**') is left-associative, "
-      "even though right-associative semantics are more useful.  "
-      "That is, `a**b**c' equals `(a**b)**c', not as `a**(b**c)'.  "
+    _("The exponentiation operator (`**') is left-associative: "
+      "`a**b**c' equals `(a**b)**c', not as `a**(b**c)'.  "
       "To disable this warning, insert parentheses.");
 
   if (lex_token (lexer) != T_NEG_NUM || lex_next_token (lexer, 1) != T_EXP)
@@ -798,6 +813,46 @@ parse_exp (struct lexer *lexer, struct expression *e)
   return node;
 }
 
+static double
+ymd_to_offset (int y, int m, int d)
+{
+  char *error;
+  double retval = calendar_gregorian_to_offset (
+    y, m, d, settings_get_fmt_settings (), &error);
+  if (error)
+    {
+      msg (SE, "%s", error);
+      free (error);
+    }
+  return retval;
+}
+
+static struct expr_node *
+expr_date (struct expression *e, int year_digits)
+{
+  static const char *months[12] =
+    {
+      "JAN", "FEB", "MAR", "APR", "MAY", "JUN",
+      "JUL", "AUG", "SEP", "OCT", "NOV", "DEC",
+    };
+
+  time_t last_proc_time = time_of_last_procedure (e->ds);
+  struct tm *time = localtime (&last_proc_time);
+
+  char *tmp = (year_digits == 2
+               ? xasprintf ("%02d-%s-%02d", time->tm_mday, months[time->tm_mon],
+                            time->tm_year % 100)
+               : xasprintf ("%02d-%s-%04d", time->tm_mday, months[time->tm_mon],
+                            time->tm_year + 1900));
+
+  struct substring s;
+  ss_alloc_substring_pool (&s, ss_cstr (tmp), e->expr_pool);
+
+  free (tmp);
+
+  return expr_allocate_string (e, s);
+}
+
 /* Parses system variables. */
 static struct expr_node *
 parse_sysvar (struct lexer *lexer, struct expression *e)
@@ -805,25 +860,9 @@ parse_sysvar (struct lexer *lexer, struct expression *e)
   if (lex_match_id (lexer, "$CASENUM"))
     return expr_allocate_nullary (e, OP_CASENUM);
   else if (lex_match_id (lexer, "$DATE"))
-    {
-      static const char *months[12] =
-        {
-          "JAN", "FEB", "MAR", "APR", "MAY", "JUN",
-          "JUL", "AUG", "SEP", "OCT", "NOV", "DEC",
-        };
-
-      time_t last_proc_time = time_of_last_procedure (e->ds);
-      struct tm *time;
-      char temp_buf[10];
-      struct substring s;
-
-      time = localtime (&last_proc_time);
-      sprintf (temp_buf, "%02d %s %02d", abs (time->tm_mday) % 100,
-               months[abs (time->tm_mon) % 12], abs (time->tm_year) % 100);
-
-      ss_alloc_substring (&s, ss_cstr (temp_buf));
-      return expr_allocate_string (e, s);
-    }
+    return expr_date (e, 2);
+  else if (lex_match_id (lexer, "$DATE11"))
+    return expr_date (e, 4);
   else if (lex_match_id (lexer, "$TRUE"))
     return expr_allocate_boolean (e, 1.0);
   else if (lex_match_id (lexer, "$FALSE"))
@@ -834,16 +873,15 @@ parse_sysvar (struct lexer *lexer, struct expression *e)
     {
       time_t time = time_of_last_procedure (e->ds);
       struct tm *tm = localtime (&time);
-      return expr_allocate_number (e, expr_ymd_to_ofs (tm->tm_year + 1900,
-                                                       tm->tm_mon + 1,
-                                                       tm->tm_mday));
+      return expr_allocate_number (e, ymd_to_offset (tm->tm_year + 1900,
+                                                     tm->tm_mon + 1,
+                                                     tm->tm_mday));
     }
   else if (lex_match_id (lexer, "$TIME"))
     {
       time_t time = time_of_last_procedure (e->ds);
       struct tm *tm = localtime (&time);
-      return expr_allocate_number (e,
-                                   expr_ymd_to_date (tm->tm_year + 1900,
+      return expr_allocate_number (e, ymd_to_offset (tm->tm_year + 1900,
                                                      tm->tm_mon + 1,
                                                      tm->tm_mday)
                                    + tm->tm_hour * 60 * 60.
@@ -1004,7 +1042,7 @@ parse_vector_element (struct lexer *lexer, struct expression *e)
     e, type, element, expr_allocate_vector (e, vector));
   expr_add_location (lexer, e, vector_start_ofs, node);
 
-  if (!type_coercion (e, node, 1))
+  if (!type_coercion (e, node, 0))
     {
       msg_at (SE, expr_location (e, node),
               _("A vector index must be numeric."));
@@ -1144,7 +1182,8 @@ match_function (struct expr_node *node,
 }
 
 static bool
-validate_function_args (const struct operation *f, int n_args, int min_valid)
+validate_function_args (const struct expression *e, const struct expr_node *n,
+                        const struct operation *f, int n_args, int min_valid)
 {
   /* Count the function arguments that go into the trailing array (if any).  We
      know that there must be at least the minimum number because
@@ -1160,7 +1199,8 @@ validate_function_args (const struct operation *f, int n_args, int min_valid)
          here. */
       assert (f->array_granularity == 2);
       assert (n_args % 2 == 0);
-      msg (SE, _("%s must have an odd number of arguments."), f->prototype);
+      msg_at (SE, expr_location (e, n),
+              _("%s must have an odd number of arguments."), f->prototype);
       return false;
     }
 
@@ -1169,9 +1209,10 @@ validate_function_args (const struct operation *f, int n_args, int min_valid)
       if (f->array_min_elems == 0)
         {
           assert ((f->flags & OPF_MIN_VALID) == 0);
-          msg (SE, _("%s function cannot accept suffix .%d to specify the "
-                     "minimum number of valid arguments."),
-               f->prototype, min_valid);
+          msg_at (SE, expr_location (e, n),
+                  _("%s function cannot accept suffix .%d to specify the "
+                    "minimum number of valid arguments."),
+                  f->prototype, min_valid);
           return false;
         }
       else
@@ -1179,9 +1220,10 @@ validate_function_args (const struct operation *f, int n_args, int min_valid)
           assert (f->flags & OPF_MIN_VALID);
           if (min_valid > array_n_args)
             {
-              msg (SE, _("For %s with %d arguments, at most %d (not %d) may be "
-                         "required to be valid."),
-                   f->prototype, n_args, array_n_args, min_valid);
+              msg_at (SE, expr_location (e, n),
+                      _("For %s with %d arguments, at most %d (not %d) may be "
+                        "required to be valid."),
+                      f->prototype, n_args, array_n_args, min_valid);
               return false;
             }
         }
@@ -1331,21 +1373,23 @@ parse_function (struct lexer *lexer, struct expression *e)
            arguments were coercible. */
         NOT_REACHED ();
       }
-  if (!validate_function_args (f, n_args, min_valid))
+  if (!validate_function_args (e, n, f, n_args, min_valid))
     goto fail;
 
   if ((f->flags & OPF_EXTENSION) && settings_get_syntax () == COMPATIBLE)
-    msg (SW, _("%s is a PSPP extension."), f->prototype);
+    msg_at (SW, expr_location (e, n),
+            _("%s is a PSPP extension."), f->prototype);
   if (f->flags & OPF_UNIMPLEMENTED)
     {
-      msg (SE, _("%s is not available in this version of PSPP."),
-           f->prototype);
+      msg_at (SE, expr_location (e, n),
+              _("%s is not available in this version of PSPP."), f->prototype);
       goto fail;
     }
   if ((f->flags & OPF_PERM_ONLY) &&
       proc_in_temporary_transformations (e->ds))
     {
-      msg (SE, _("%s may not appear after %s."), f->prototype, "TEMPORARY");
+      msg_at (SE, expr_location (e, n),
+              _("%s may not appear after %s."), f->prototype, "TEMPORARY");
       goto fail;
     }
 
index e77ce4d941c852e7fe0e0cea7713a5af9cb513e4..19cac31be748b1fda85a2c5bae36346d4d5d28a7 100644 (file)
@@ -33,36 +33,40 @@ enum operation_flags
        missing input values (although it is not obliged to do
        so).  Unless this bit is set, the operation's evaluation
        function will never be passed a missing argument. */
-    OPF_ABSORB_MISS = 004,
+    OPF_ABSORB_MISS = 1 << 0,
 
     /* If set, this operation's final operand is an array of one
        or more elements. */
-    OPF_ARRAY_OPERAND = 001,
+    OPF_ARRAY_OPERAND = 1 << 1,
 
     /* If set, the user can specify the minimum number of array
        elements that must be non-missing for the function result
        to be non-missing.  The operation must have an array
        operand and the array must contain `double's.  Both
        OPF_ABSORB_MISS and OPF_ARRAY_OPERAND must also be set. */
-    OPF_MIN_VALID = 002,
+    OPF_MIN_VALID = 1 << 2,
 
     /* If set, operation is non-optimizable in general.  Unless
        combined with OPF_ABSORB_MISS, missing input values are
        still assumed to yield missing results. */
-    OPF_NONOPTIMIZABLE = 010,
+    OPF_NONOPTIMIZABLE = 1 << 3,
 
     /* If set, this operation is not implemented. */
-    OPF_UNIMPLEMENTED = 020,
+    OPF_UNIMPLEMENTED = 1 << 4,
 
     /* If set, this operation is a PSPP extension. */
-    OPF_EXTENSION = 040,
+    OPF_EXTENSION = 1 << 5,
 
     /* If set, this operation may not occur after TEMPORARY.
        (Currently this applies only to LAG.) */
-    OPF_PERM_ONLY = 0100,
+    OPF_PERM_ONLY = 1 << 6,
 
     /* If set, this operation's name may not be abbreviated. */
-    OPF_NO_ABBREV = 0200
+    OPF_NO_ABBREV = 1 << 7,
+
+    /* If set, this operation needs the "struct expr_node *", for message
+       locations. */
+    OPF_EXPR_NODE = 1 << 8,
   };
 
 #define EXPR_ARG_MAX 4
@@ -124,6 +128,7 @@ union operation_data
     const struct variable *variable;
     const struct vector *vector;
     struct fmt_spec *format;
+    const struct expr_node *node;
     int integer;
   };
 
@@ -170,4 +175,7 @@ struct expr_node *expr_allocate_format (struct expression *e,
 struct expr_node *expr_allocate_vector (struct expression *e,
                                       const struct vector *);
 
+const struct msg_location *expr_location (const struct expression *,
+                                          const struct expr_node *);
+
 #endif /* expressions/private.h */
index 02b713f8b96aad762efa8cf8c5b1f60143639de1..121e98fac25ffcfe7f8ad877e99ada757f2636ba 100644 (file)
@@ -17,6 +17,7 @@ dnl
 AT_BANNER([expression parsing])
 
 AT_SETUP([parse expression with unknown variable crash])
+AT_KEYWORDS([expression expressions parse])
 AT_DATA([parse.sps], [dnl
 INPUT PROGRAM.
 LOOP c=1 to 10.
@@ -39,94 +40,114 @@ parse.sps:11: error: Stopping syntax file processing here to avoid a cascade of
 AT_CLEANUP
 
 AT_SETUP([parsing boolean expression with type mismatch])
+AT_KEYWORDS([expression expressions parse])
 AT_DATA([parse.sps], [dnl
 DATA LIST NOTABLE/x 1(A).
 IF 'foo'.
 ])
-AT_CHECK([pspp -O format=csv parse.sps], [1], [dnl
-"parse.sps:2: error: IF: Type mismatch: expression has string type, but a boolean value is required here."
+AT_CHECK([pspp parse.sps], [1], [dnl
+parse.sps:2.4-2.8: error: IF: Type mismatch: expression has string type, but a
+boolean value is required here.
+    2 | IF 'foo'.
+      |    ^~~~~
 ])
 AT_CLEANUP
 
 AT_SETUP([parsing numeric expression with type mismatch])
+AT_KEYWORDS([expression expressions parse])
 AT_DATA([parse.sps], [dnl
 DATA LIST NOTABLE/x 1.
 COMPUTE x='foo'.
 ])
-AT_CHECK([pspp -O format=csv parse.sps], [1], [dnl
-"parse.sps:2: error: COMPUTE: Type mismatch: expression has string type, but a numeric value is required here."
+AT_CHECK([pspp parse.sps], [1], [dnl
+parse.sps:2.11-2.15: error: COMPUTE: Type mismatch: expression has type
+'string', but a numeric value is required.
+    2 | COMPUTE x='foo'.
+      |           ^~~~~
 ])
 AT_CLEANUP
 
 AT_SETUP([parsing string expression with type mismatch])
-AT_KEYWORDS([expression negative])
+AT_KEYWORDS([expression expressions parse negative])
 AT_DATA([parse.sps], [dnl
 DATA LIST NOTABLE/x 1(A).
 COMPUTE x=1.
 ])
-AT_CHECK([pspp -O format=csv parse.sps], [1], [dnl
-"parse.sps:2: error: COMPUTE: Type mismatch: expression has number type, but a string value is required here."
+AT_CHECK([pspp parse.sps], [1], [dnl
+parse.sps:2.11: error: COMPUTE: Type mismatch: expression has type 'number',
+but a string value is required.
+    2 | COMPUTE x=1.
+      |           ^
 ])
 AT_CLEANUP
 
 AT_SETUP([assigning string expression to new variable])
-AT_KEYWORDS([expression negative])
+AT_KEYWORDS([expression expressions parse negative])
 AT_DATA([parse.sps], [dnl
 DATA LIST NOTABLE/x 1(A).
 COMPUTE y='a'.
 ])
-AT_CHECK([pspp -O format=csv parse.sps], [1], [dnl
-"parse.sps:2: error: COMPUTE: This command tries to create a new variable y by assigning a string value to it, but this is not supported.  Use the STRING command to create the new variable with the correct width before assigning to it, e.g. STRING y(A20)."
+AT_CHECK([pspp parse.sps], [1], [dnl
+parse.sps:2: error: COMPUTE: This command tries to create a new variable y by
+assigning a string value to it, but this is not supported.  Use the STRING
+command to create the new variable with the correct width before assigning to
+it, e.g. STRING y(A20).
 ])
 AT_CLEANUP
 
 AT_SETUP([parse expression with unknown system variable])
-AT_KEYWORDS([expression negative])
+AT_KEYWORDS([expression expressions parse negative])
 AT_DATA([parse.sps], [dnl
 DATA LIST NOTABLE/x 1.
 COMPUTE x=$nonexistent.
 ])
-AT_CHECK([pspp -O format=csv parse.sps], [1], [dnl
+AT_CHECK([pspp parse.sps], [1], [dnl
 parse.sps:2: error: COMPUTE: Unknown system variable $nonexistent.
 ])
 AT_CLEANUP
 
 AT_SETUP([parse expression with unknown identifier])
-AT_KEYWORDS([expression negative])
+AT_KEYWORDS([expression expressions parse negative])
 AT_DATA([parse.sps], [dnl
 DATA LIST NOTABLE/x 1.
 COMPUTE x=y.
 ])
-AT_CHECK([pspp -O format=csv parse.sps], [1], [dnl
+AT_CHECK([pspp parse.sps], [1], [dnl
 parse.sps:2: error: COMPUTE: Unknown identifier y.
 ])
 AT_CLEANUP
 
 AT_SETUP([parse expression with extension function in compatibility mode])
-AT_KEYWORDS([expression negative])
+AT_KEYWORDS([expression expressions parse negative])
 AT_DATA([parse.sps], [dnl
 DEBUG EVALUATE/ACOS(0)*0.
 ])
-AT_CHECK([pspp --testing-mode --syntax=compatible -O format=csv parse.sps], [0], [dnl
-parse.sps:1: warning: DEBUG EVALUATE: ACOS(number) is a PSPP extension.
+AT_CHECK([pspp --testing-mode --syntax=compatible parse.sps], [0], [dnl
+parse.sps:1.16-1.22: warning: DEBUG EVALUATE: ACOS(number) is a PSPP extension.
+    1 | DEBUG EVALUATE/ACOS(0)*0.
+      |                ^~~~~~~
 
-0.00
+ACOS(0)*0 => 0.00
 ])
 AT_CLEANUP
 
 AT_SETUP([LAG expression following TEMPORARY])
-AT_KEYWORDS([expression negative])
+AT_KEYWORDS([expression expressions parse negative])
 AT_DATA([parse.sps], [dnl
 DATA LIST NOTABLE/x 1.
 TEMPORARY
 COMPUTE y=LAG(x).
 ])
-AT_CHECK([pspp -O format=csv parse.sps], [1], [dnl
-parse.sps:3: error: COMPUTE: LAG(num_variable) may not appear after TEMPORARY.
+AT_CHECK([pspp parse.sps], [1], [dnl
+parse.sps:3.11-3.16: error: COMPUTE: LAG(num_variable) may not appear after
+TEMPORARY.
+    3 | COMPUTE y=LAG(x).
+      |           ^~~~~~
 ])
 AT_CLEANUP
 
 AT_SETUP([parse expression with invalid logical expression])
+AT_KEYWORDS([expression expressions parse negative])
 AT_DATA([parse.sps], [dnl
 INPUT PROGRAM.
 LOOP c=1 to 10.
@@ -138,7 +159,292 @@ END INPUT PROGRAM.
 
 SELECT IF 2.
 ])
-AT_CHECK([pspp -O format=csv parse.sps], [1], [dnl
-"parse.sps:9: error: SELECT IF: A logical expression was found to have a value other than 0 (false), 1 (true), or the system-missing value.  The result was forced to 0."
+AT_CHECK([pspp parse.sps], [1], [dnl
+parse.sps:9.11: error: SELECT IF: This logical expression must evaluate to 0 or
+1.  Treating unexpected value 2 as 0.
+    9 | SELECT IF 2.
+      |           ^
+])
+AT_CLEANUP
+
+AT_SETUP([chaining operators that shouldn't be])
+AT_KEYWORDS([expression expressions parse negative])
+AT_DATA([parse.sps], [dnl
+INPUT PROGRAM.
+* These should provoke warnings.
+COMPUTE a = 1 < 2 < 3.
+COMPUTE b = 1 > 2 < 0.
+COMPUTE c = 2**3**4.
+
+* These should not provoke warnings.
+COMPUTE d = (1 < 2) < 3.
+COMPUTE e = (2**3)**4.
+END INPUT PROGRAM.
+])
+AT_CHECK([pspp parse.sps], [1], [dnl
+parse.sps:3.13-3.21: warning: COMPUTE: Chaining relational operators (e.g. `a <
+b < c') will 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'.)
+    3 | COMPUTE a = 1 < 2 < 3.
+      |             ^~~~~~~~~
+
+parse.sps:4.13-4.21: warning: COMPUTE: Chaining relational operators (e.g. `a <
+b < c') will 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'.)
+    4 | COMPUTE b = 1 > 2 < 0.
+      |             ^~~~~~~~~
+
+parse.sps:5.13-5.19: warning: COMPUTE: The exponentiation operator (`**') is
+left-associative: `a**b**c' equals `(a**b)**c', not as `a**(b**c)'.  To disable
+this warning, insert parentheses.
+    5 | COMPUTE c = 2**3**4.
+      |             ^~~~~~~
+
+parse.sps:10: error: INPUT PROGRAM: Input program must contain DATA LIST or END
+FILE.
+])
+AT_CLEANUP
+
+AT_SETUP([binary operator type mismatch])
+AT_KEYWORDS([expression expressions parse negative])
+AT_DATA([parse.sps], [dnl
+DEBUG EVALUATE /1 + 'a'.
+DEBUG EVALUATE /'a' + 1.
+DEBUG EVALUATE /'a' + 'a'.
+DEBUG EVALUATE /'a' + ('a').
+
+DEBUG EVALUATE /1 < 'a'.
+DEBUG EVALUATE /'a' < 1.
+DEBUG EVALUATE /'a' < 'b' < 'c'.
+])
+AT_CHECK([pspp --testing-mode parse.sps], [1], [dnl
+parse.sps:1.17-1.23: error: DEBUG EVALUATE: Both operands of + must be numeric.
+    1 | DEBUG EVALUATE /1 + 'a'.
+      |                 ^~~~~~~
+
+parse.sps:1.17: note: DEBUG EVALUATE: This operand has type 'number'.
+    1 | DEBUG EVALUATE /1 + 'a'.
+      |                 ^
+
+parse.sps:1.21-1.23: note: DEBUG EVALUATE: This operand has type 'string'.
+    1 | DEBUG EVALUATE /1 + 'a'.
+      |                     ^~~
+
+1 + 'a' => error
+
+parse.sps:2.17-2.23: error: DEBUG EVALUATE: Both operands of + must be numeric.
+    2 | DEBUG EVALUATE /'a' + 1.
+      |                 ^~~~~~~
+
+parse.sps:2.17-2.19: note: DEBUG EVALUATE: This operand has type 'string'.
+    2 | DEBUG EVALUATE /'a' + 1.
+      |                 ^~~
+
+parse.sps:2.23: note: DEBUG EVALUATE: This operand has type 'number'.
+    2 | DEBUG EVALUATE /'a' + 1.
+      |                       ^
+
+'a' + 1 => error
+
+'a' + 'a' => "aa"
+
+parse.sps:4.17-4.26: error: DEBUG EVALUATE: Both operands of + must be numeric.
+    4 | DEBUG EVALUATE /'a' + ('a').
+      |                 ^~~~~~~~~~
+
+parse.sps:4.17-4.19: note: DEBUG EVALUATE: This operand has type 'string'.
+    4 | DEBUG EVALUATE /'a' + ('a').
+      |                 ^~~
+
+parse.sps:4.24-4.26: note: DEBUG EVALUATE: This operand has type 'string'.
+    4 | DEBUG EVALUATE /'a' + ('a').
+      |                        ^~~
+
+'a' + ('a') => error
+
+parse.sps:6.17-6.23: error: DEBUG EVALUATE: Both operands of < must have the
+same type.
+    6 | DEBUG EVALUATE /1 < 'a'.
+      |                 ^~~~~~~
+
+parse.sps:6.17: note: DEBUG EVALUATE: This operand has type 'number'.
+    6 | DEBUG EVALUATE /1 < 'a'.
+      |                 ^
+
+parse.sps:6.21-6.23: note: DEBUG EVALUATE: This operand has type 'string'.
+    6 | DEBUG EVALUATE /1 < 'a'.
+      |                     ^~~
+
+1 < 'a' => error
+
+parse.sps:7.17-7.23: error: DEBUG EVALUATE: Both operands of < must have the
+same type.
+    7 | DEBUG EVALUATE /'a' < 1.
+      |                 ^~~~~~~
+
+parse.sps:7.17-7.19: note: DEBUG EVALUATE: This operand has type 'string'.
+    7 | DEBUG EVALUATE /'a' < 1.
+      |                 ^~~
+
+parse.sps:7.23: note: DEBUG EVALUATE: This operand has type 'number'.
+    7 | DEBUG EVALUATE /'a' < 1.
+      |                       ^
+
+'a' < 1 => error
+
+parse.sps:8.17-8.31: error: DEBUG EVALUATE: Both operands of < must have the
+same type.
+    8 | DEBUG EVALUATE /'a' < 'b' < 'c'.
+      |                 ^~~~~~~~~~~~~~~
+
+parse.sps:8.17-8.25: note: DEBUG EVALUATE: This operand has type 'number'.
+    8 | DEBUG EVALUATE /'a' < 'b' < 'c'.
+      |                 ^~~~~~~~~
+
+parse.sps:8.29-8.31: note: DEBUG EVALUATE: This operand has type 'string'.
+    8 | DEBUG EVALUATE /'a' < 'b' < 'c'.
+      |                             ^~~
+
+'a' < 'b' < 'c' => error
+])
+AT_CLEANUP
+
+AT_SETUP([unary operator type mismatch])
+AT_KEYWORDS([expression expressions parse negative])
+AT_DATA([parse.sps], [dnl
+DEBUG EVALUATE /-'a'.
+DEBUG EVALUATE /----'a'.
+DEBUG EVALUATE /NOT 'a'.
+DEBUG EVALUATE /NOT NOT NOT 'a'.
+DEBUG EVALUATE /NOT F5.2.
+])
+AT_CHECK([pspp --testing-mode parse.sps], [1], [dnl
+parse.sps:1.17-1.20: error: DEBUG EVALUATE: The unary - operator requires a
+numeric operand.
+    1 | DEBUG EVALUATE /-'a'.
+      |                 ^~~~
+
+parse.sps:1.18-1.20: note: DEBUG EVALUATE: The operand of - has type 'string'.
+    1 | DEBUG EVALUATE /-'a'.
+      |                  ^~~
+
+-'a' => error
+
+parse.sps:2.17-2.23: error: DEBUG EVALUATE: The unary - operator requires a
+numeric operand.
+    2 | DEBUG EVALUATE /----'a'.
+      |                 ^~~~~~~
+
+parse.sps:2.21-2.23: note: DEBUG EVALUATE: The operand of - has type 'string'.
+    2 | DEBUG EVALUATE /----'a'.
+      |                     ^~~
+
+----'a' => error
+
+parse.sps:3.17-3.23: error: DEBUG EVALUATE: The unary NOT operator requires a
+numeric operand.
+    3 | DEBUG EVALUATE /NOT 'a'.
+      |                 ^~~~~~~
+
+parse.sps:3.21-3.23: note: DEBUG EVALUATE: The operand of NOT has type
+'string'.
+    3 | DEBUG EVALUATE /NOT 'a'.
+      |                     ^~~
+
+NOT 'a' => error
+
+parse.sps:4.17-4.31: error: DEBUG EVALUATE: The unary NOT operator requires a
+numeric operand.
+    4 | DEBUG EVALUATE /NOT NOT NOT 'a'.
+      |                 ^~~~~~~~~~~~~~~
+
+parse.sps:4.29-4.31: note: DEBUG EVALUATE: The operand of NOT has type
+'string'.
+    4 | DEBUG EVALUATE /NOT NOT NOT 'a'.
+      |                             ^~~
+
+NOT NOT NOT 'a' => error
+
+parse.sps:5.17-5.24: error: DEBUG EVALUATE: The unary NOT operator requires a
+numeric operand.
+    5 | DEBUG EVALUATE /NOT F5.2.
+      |                 ^~~~~~~~
+
+parse.sps:5.21-5.24: note: DEBUG EVALUATE: The operand of NOT has type
+'format'.
+    5 | DEBUG EVALUATE /NOT F5.2.
+      |                     ^~~~
+
+NOT F5.2 => error
+])
+AT_CLEANUP
+
+AT_SETUP([parsing with negative numbers])
+AT_KEYWORDS([expression expressions parse])
+AT_DATA([parse.sps], [dnl
+DEBUG EVALUATE NOOPT POSTFIX /-2**3.
+DEBUG EVALUATE NOOPT POSTFIX /-2**-3**-4.
+DEBUG EVALUATE/1 - 2.
+])
+AT_CHECK([pspp --testing-mode parse.sps], [0], [dnl
+number: n<2> number: n<3> POW NEG return_number
+
+parse.sps:2.35-2.40: warning: DEBUG EVALUATE: The exponentiation operator
+(`**') is left-associative: `a**b**c' equals `(a**b)**c', not as `a**(b**c)'.
+To disable this warning, insert parentheses.
+    2 | DEBUG EVALUATE NOOPT POSTFIX /-2**-3**-4.
+      |                                   ^~~~~~
+
+number: n<2> number: n<-3> POW number: n<-4> POW NEG return_number
+
+1 - 2 => -1.00
+])
+AT_CLEANUP
+
+AT_SETUP([system variables])
+AT_KEYWORDS([expression expressions parse])
+AT_DATA([parse.sps], [dnl
+DEBUG EVALUATE /$WIDTH.
+DEBUG EVALUATE /$LENGTH.
+DEBUG EVALUATE /$SYSMIS.
+])
+AT_CHECK([pspp --testing-mode parse.sps], [0], [dnl
+$WIDTH => 79.00
+
+$LENGTH => 24.00
+
+$SYSMIS => sysmis
+])
+AT_CLEANUP
+
+# This test will fail if the current date changes during the test.
+AT_SETUP([system variables - $DATE $DATE11])
+AT_KEYWORDS([expression expressions parse])
+# Get the date in the formats that $DATE and $DATE11 support.
+date=$(date +%d-%^b-%y)
+date11=$(date +%d-%^b-%Y)
+echo "date=$date"              # Should be date=DD-MMM-YY.
+echo "date11=$date11"  # Should be date11=DD-MMM-YYYY.
+
+# Maybe we don't have the 'date' program or it doesn't work as we
+# expect.  Check by trying to see if $date and $date11 are in the
+# expected format.  If not, skip the test.
+AS_CASE([$date],
+  [[[0-9][0-9]-[A-Z][A-Z][A-Z]-[0-9][0-9]]], [],
+  [AT_SKIP_IF([:])])  
+AS_CASE([$date11],
+  [[[0-9][0-9]-[A-Z][A-Z][A-Z]-[0-9][0-9][0-9][0-9]]], [],
+  [AT_SKIP_IF([:])])  
+
+AT_DATA([parse.sps], [dnl
+DEBUG EVALUATE /$DATE.
+DEBUG EVALUATE /$DATE11.
+])
+AT_CHECK_UNQUOTED([pspp --testing-mode parse.sps], [0], [dnl
+\$DATE => "$date"
+
+\$DATE11 => "$date11"
 ])
 AT_CLEANUP