X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=src%2Flanguage%2Fexpressions%2Fparse.c;h=7eccdac2b12810b28b29bd5d8aa9c7016a47fa08;hb=9b134313fe8b9e8d74be8795cbbf4e5745344f12;hp=2b78b0b14b41491cc172fc301ac4476fdf0765ba;hpb=d3c96903451307e60d1d4a680ecf58c86cac7eaa;p=pspp diff --git a/src/language/expressions/parse.c b/src/language/expressions/parse.c index 2b78b0b14b..7eccdac2b1 100644 --- a/src/language/expressions/parse.c +++ b/src/language/expressions/parse.c @@ -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 *); @@ -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; }