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)
+ 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
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);
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;
}
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);
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;
#include <config.h>
+#include "language/expressions/private.h"
#include "evaluate.h"
#include <ctype.h>
#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"
struct dataset *ds = NULL;
char *name = NULL;
+ char *title = NULL;
struct expression *expr;
}
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;
}
{
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;
{
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;
}
case_unref (c);
free (name);
+ free (title);
return retval;
}
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 ();
}
'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'),
'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'),
# 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'),
# Used only for debugging purposes.
Type.new_atom('operation'),
+ Type.new_atom('exprnode'),
]:
types[t.name] = t
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'
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]
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:
/* 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. */
/* 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
{
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;
}
/* 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)
/* 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")))
{
}
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;
}
}
/* 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;
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;
/* 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:
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)
{
#include "gettext.h"
#define _(msgid) gettext (msgid)
+struct expr_node;
+
static inline double check_errno (double x)
{
return errno == 0 ? x : SYSMIS;
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 *,
// 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
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);
// 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.
}
function NUMBER (string s, ni_format f)
+ expression e;
+ expr_node n;
{
union value out;
char *error;
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;
// 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.
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))
{
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;
}
}
expression e;
vector v;
case c;
+ expr_node n;
{
if (idx >= 1 && idx <= vector_get_n_vars (v))
{
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;
}
}
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;
}
|| 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. */
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
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
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;
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);
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);
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;
}
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;
}
/* 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)
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);
}
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 ();
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)
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)
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"))
{
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.
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."));
}
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
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;
}
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
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;
}
}
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;
}
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
const struct variable *variable;
const struct vector *vector;
struct fmt_spec *format;
+ const struct expr_node *node;
int integer;
};
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 */
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.
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.
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