/* PSPP - a program for statistical analysis.
- Copyright (C) 1997-9, 2000, 2006, 2010, 2011 Free Software Foundation, Inc.
+ Copyright (C) 1997-9, 2000, 2006, 2010, 2011, 2012, 2014 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
#include "language/lexer/variable-parser.h"
#include "libpspp/array.h"
#include "libpspp/assertion.h"
+#include "libpspp/i18n.h"
#include "libpspp/message.h"
#include "libpspp/misc.h"
#include "libpspp/pool.h"
#include "libpspp/str.h"
+#include "gl/c-strcase.h"
#include "gl/xalloc.h"
\f
/* Declarations. */
static const char *atom_type_name (atom_type);
static struct expression *finish_expression (union any_node *,
struct expression *);
-static bool type_check (struct expression *, union any_node **,
- enum expr_type expected_type);
+static bool type_check (const union any_node *, enum val_type expected_type);
static union any_node *allocate_unary_variable (struct expression *,
const struct variable *);
\f
/* Public functions. */
-/* Parses an expression of the given TYPE.
- If DICT is nonnull then variables and vectors within it may be
- referenced within the expression; otherwise, the expression
- must not reference any variables or vectors.
- Returns the new expression if successful or a null pointer
- otherwise. */
+/* Parses an expression of the given TYPE. If DS is nonnull then variables and
+ vectors within it may be referenced within the expression; otherwise, the
+ expression must not reference any variables or vectors. Returns the new
+ expression if successful or a null pointer otherwise. If POOL is nonnull,
+ then destroying POOL will free the expression; otherwise, the caller must
+ eventually free it with expr_free(). */
struct expression *
-expr_parse (struct lexer *lexer, struct dataset *ds, enum expr_type type)
+expr_parse (struct lexer *lexer, struct pool *pool, struct dataset *ds,
+ enum val_type type)
{
- union any_node *n;
- struct expression *e;
+ assert (val_type_is_valid (type));
- assert (type == EXPR_NUMBER || type == EXPR_STRING || type == EXPR_BOOLEAN);
+ struct expression *e = expr_create (ds);
+ union any_node *n = parse_or (lexer, e);
+ if (!n || !type_check (n, type))
+ {
+ expr_free (e);
+ return NULL;
+ }
- e = expr_create (ds);
- n = parse_or (lexer, e);
- if (n != NULL && type_check (e, &n, type))
- return finish_expression (expr_optimize (n, e), e);
- else
+ e = finish_expression (expr_optimize (n, e), e);
+ if (pool)
+ pool_add_subpool (pool, e->expr_pool);
+ return e;
+}
+
+/* Parses a boolean expression, otherwise similar to expr_parse(). */
+struct expression *
+expr_parse_bool (struct lexer *lexer, struct pool *pool, struct dataset *ds)
+{
+ struct expression *e = expr_create (ds);
+ union any_node *n = parse_or (lexer, e);
+ if (!n)
{
expr_free (e);
return NULL;
}
+
+ atom_type actual_type = expr_node_returns (n);
+ if (actual_type == OP_number)
+ n = expr_allocate_binary (e, OP_NUM_TO_BOOLEAN, n,
+ expr_allocate_string (e, ss_empty ()));
+ else if (actual_type != OP_boolean)
+ {
+ msg (SE, _("Type mismatch: expression has %s type, "
+ "but a boolean value is required here."),
+ atom_type_name (actual_type));
+ expr_free (e);
+ return NULL;
+ }
+
+ e = finish_expression (expr_optimize (n, e), e);
+ if (pool)
+ pool_add_subpool (pool, e->expr_pool);
+ return e;
}
-/* Parses and returns an expression of the given TYPE, as
- expr_parse(), and sets up so that destroying POOL will free
- the expression as well. */
+/* Parses a numeric expression that is intended to be assigned to newly created
+ variable NEW_VAR_NAME. (This allows for a better error message if the
+ expression is not numeric.) Otherwise similar to expr_parse(). */
struct expression *
-expr_parse_pool (struct lexer *lexer,
- struct pool *pool,
- struct dataset *ds,
- enum expr_type type)
+expr_parse_new_variable (struct lexer *lexer, struct pool *pool, struct dataset *ds,
+ const char *new_var_name)
{
- struct expression *e = expr_parse (lexer, ds, type);
- if (e != NULL)
+ struct expression *e = expr_create (ds);
+ union any_node *n = parse_or (lexer, e);
+ if (!n)
+ {
+ expr_free (e);
+ return NULL;
+ }
+
+ atom_type actual_type = expr_node_returns (n);
+ if (actual_type != OP_number && actual_type != OP_boolean)
+ {
+ msg (SE, _("This command tries to create a new variable %s 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 %s(A20)."),
+ new_var_name, new_var_name);
+ expr_free (e);
+ return NULL;
+ }
+
+ e = finish_expression (expr_optimize (n, e), e);
+ if (pool)
pool_add_subpool (pool, e->expr_pool);
return e;
}
converted to type EXPECTED_TYPE, inserting a conversion at *N
if necessary. Returns true if successful, false on failure. */
static bool
-type_check (struct expression *e,
- union any_node **n, enum expr_type expected_type)
+type_check (const union any_node *n, enum val_type expected_type)
{
- atom_type actual_type = expr_node_returns (*n);
+ atom_type actual_type = expr_node_returns (n);
switch (expected_type)
{
- case EXPR_BOOLEAN:
- case EXPR_NUMBER:
+ case VAL_NUMERIC:
if (actual_type != OP_number && actual_type != OP_boolean)
{
msg (SE, _("Type mismatch: expression has %s type, "
atom_type_name (actual_type));
return false;
}
- if (actual_type == OP_number && expected_type == OP_boolean)
- *n = expr_allocate_unary (e, OP_NUM_TO_BOOLEAN, *n);
break;
- case EXPR_STRING:
+ case VAL_STRING:
if (actual_type != OP_string)
{
msg (SE, _("Type mismatch: expression has %s type, "
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);
- return expr_allocate_string_buffer (e, temp_buf, strlen (temp_buf));
+ ss_alloc_substring (&s, ss_cstr (temp_buf));
+ return expr_allocate_string (e, s);
}
else if (lex_match_id (lexer, "$TRUE"))
return expr_allocate_boolean (e, 1.0);
switch (lex_token (lexer))
{
case T_ID:
- if (lex_look_ahead (lexer) == T_LPAREN)
+ if (lex_next_token (lexer, 1) == T_LPAREN)
{
/* An identifier followed by a left parenthesis may be
a vector element reference. If not, it's a function
case T_POS_NUM:
case T_NEG_NUM:
{
- union any_node *node = expr_allocate_number (e, lex_tokval (lexer) );
+ union any_node *node = expr_allocate_number (e, lex_tokval (lexer));
lex_get (lexer);
return node;
}
case T_STRING:
{
- union any_node *node = expr_allocate_string_buffer (
- e, lex_tokcstr (lexer), ss_length (lex_tokss (lexer)));
+ const char *dict_encoding;
+ union any_node *node;
+ char *s;
+
+ dict_encoding = (e->ds != NULL
+ ? dict_get_encoding (dataset_dict (e->ds))
+ : "UTF-8");
+ s = recode_string_pool (dict_encoding, "UTF-8", lex_tokcstr (lexer),
+ ss_length (lex_tokss (lexer)), e->expr_pool);
+ node = expr_allocate_string (e, ss_cstr (s));
+
lex_get (lexer);
return node;
}
case T_LPAREN:
{
- union any_node *node;
- lex_get (lexer);
- node = parse_or (lexer, e);
- if (node != NULL && !lex_force_match (lexer, T_RPAREN))
+ /* Count number of left parentheses so that we can match them against
+ an equal number of right parentheses. This defeats trivial attempts
+ to exhaust the stack with a lot of left parentheses. (More
+ sophisticated attacks will still succeed.) */
+ size_t n = 0;
+ while (lex_match (lexer, T_LPAREN))
+ n++;
+
+ union any_node *node = parse_or (lexer, e);
+ if (!node)
return NULL;
+
+ for (size_t i = 0; i < n; i++)
+ if (!lex_force_match (lexer, T_RPAREN))
+ return NULL;
+
return node;
}
return true;
}
+/* Returns 0 if TOKEN and FUNC do not match,
+ 1 if TOKEN is an acceptable abbreviation for FUNC,
+ 2 if TOKEN equals FUNC. */
static int
-compare_names (const char *test, const char *name, bool abbrev_ok)
-{
- if (!abbrev_ok)
- return true;
-
- for (;;)
- {
- if (!word_matches (&test, &name))
- return true;
- if (*name == '\0' && *test == '\0')
- return false;
- }
-}
-
-static int
-compare_strings (const char *test, const char *name, bool abbrev_ok UNUSED)
+compare_function_names (const char *token_, const char *func_)
{
- return strcasecmp (test, name);
+ const char *token = token_;
+ const char *func = func_;
+ while (*token || *func)
+ if (!word_matches (&token, &func))
+ return 0;
+ return !c_strcasecmp (token_, func_) ? 2 : 1;
}
static bool
-lookup_function_helper (const char *name,
- int (*compare) (const char *test, const char *name,
- bool abbrev_ok),
- const struct operation **first,
- const struct operation **last)
+lookup_function (const char *token,
+ const struct operation **first,
+ const struct operation **last)
{
- const struct operation *f;
+ *first = *last = NULL;
+ const struct operation *best = NULL;
- for (f = operations + OP_function_first;
+ for (const struct operation *f = operations + OP_function_first;
f <= operations + OP_function_last; f++)
- if (!compare (name, f->name, !(f->flags & OPF_NO_ABBREV)))
- {
- *first = f;
+ {
+ int score = compare_function_names (token, f->name);
+ if (score == 2)
+ {
+ best = f;
+ break;
+ }
+ else if (score == 1 && !(f->flags & OPF_NO_ABBREV) && !best)
+ best = f;
+ }
- while (f <= operations + OP_function_last
- && !compare (name, f->name, !(f->flags & OPF_NO_ABBREV)))
- f++;
- *last = f;
+ if (!best)
+ return false;
- return true;
- }
+ *first = best;
- return false;
-}
+ const struct operation *f = best;
+ while (f <= operations + OP_function_last
+ && !c_strcasecmp (f->name, best->name))
+ f++;
+ *last = f;
-static bool
-lookup_function (const char *name,
- const struct operation **first,
- const struct operation **last)
-{
- *first = *last = NULL;
- return (lookup_function_helper (name, compare_strings, first, last)
- || lookup_function_helper (name, compare_names, first, last));
+ return true;
}
static int
static bool
validate_function_args (const struct operation *f, int arg_cnt, 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
+ match_function() already checked. */
int array_arg_cnt = arg_cnt - (f->arg_cnt - 1);
- if (array_arg_cnt < f->array_min_elems)
- {
- msg (SE, _("%s must have at least %d arguments in list."),
- f->prototype, f->array_min_elems);
- return false;
- }
+ assert (array_arg_cnt >= f->array_min_elems);
if ((f->flags & OPF_ARRAY_OPERAND)
&& array_arg_cnt % f->array_granularity != 0)
{
- if (f->array_granularity == 2)
- msg (SE, _("%s must have an even number of arguments in list."),
- f->prototype);
- else
- msg (SE, _("%s must have multiple of %d arguments in list."),
- f->prototype, f->array_granularity);
+ /* RANGE is the only case we have so far. It has paired arguments with
+ one initial argument, and that's the only special case we deal with
+ here. */
+ assert (f->array_granularity == 2);
+ assert (arg_cnt % 2 == 0);
+ msg (SE, _("%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 does not accept a minimum valid "
- "argument count."), f->prototype);
+ msg (SE, _("%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 (array_arg_cnt < f->array_min_elems)
+ if (min_valid > array_arg_cnt)
{
- msg (SE, _("%s requires at least %d valid arguments in list."),
- f->prototype, f->array_min_elems);
- return false;
- }
- else if (min_valid > array_arg_cnt)
- {
- msg (SE, _("With %s, "
- "using minimum valid argument count of %d "
- "does not make sense when passing only %d "
- "arguments in list."),
- f->prototype, min_valid, array_arg_cnt);
+ msg (SE, _("For %s with %d arguments, at most %d (not %d) may be "
+ "required to be valid."),
+ f->prototype, arg_cnt, array_arg_cnt, min_valid);
return false;
}
}
for (;;)
{
if (lex_token (lexer) == T_ID
- && toupper (lex_look_ahead (lexer)) == T_ID)
+ && lex_next_token (lexer, 1) == T_TO)
{
const struct variable **vars;
size_t var_cnt;
break;
else if (!lex_match (lexer, T_COMMA))
{
- lex_error (lexer, _("expecting `,' or `)' invoking %s function"),
- first->name);
+ lex_error_expecting (lexer, "`,'", "`)'");
goto fail;
}
}
msg (SW, _("%s is a PSPP extension."), f->prototype);
if (f->flags & OPF_UNIMPLEMENTED)
{
- msg (SE, _("%s is not yet implemented."), f->prototype);
+ msg (SE, _("%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 TEMPORARY."), f->prototype);
+ msg (SE, _("%s may not appear after %s."), f->prototype, "TEMPORARY");
goto fail;
}
return n;
}
-union any_node *
-expr_allocate_string_buffer (struct expression *e,
- const char *string, size_t length)
-{
- union any_node *n = pool_alloc (e->expr_pool, sizeof n->string);
- n->type = OP_string;
- if (length > MAX_STRING)
- length = MAX_STRING;
- n->string.s = copy_string (e, string, length);
- return n;
-}
-
union any_node *
expr_allocate_string (struct expression *e, struct substring s)
{
projects / pspp / blobdiff