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;
}
projects / pspp / blobdiff