diff options
author | Daniel Kraft <d@domob.eu> | 2008-08-22 09:13:25 +0200 |
---|---|---|
committer | Daniel Kraft <domob@gcc.gnu.org> | 2008-08-22 09:13:25 +0200 |
commit | f37e928ca481ce81aeae79ae9fb9504f2d13b3a1 (patch) | |
tree | 7eadcf3647d5b38792adf1c288e5c984abfbad59 /gcc/fortran/parse.c | |
parent | 6b7387327a09e13e7b7ae2fd5f0371b0f88189e9 (diff) | |
download | gcc-f37e928ca481ce81aeae79ae9fb9504f2d13b3a1.zip gcc-f37e928ca481ce81aeae79ae9fb9504f2d13b3a1.tar.gz gcc-f37e928ca481ce81aeae79ae9fb9504f2d13b3a1.tar.bz2 |
re PR fortran/32095 (Accepts invalid character(len(a)),dimension(1) :: a)
2008-08-22 Daniel Kraft <d@domob.eu>
PR fortran/32095
PR fortran/34228
* gfortran.h (in_prefix): New global.
(gfc_check_symbol_typed), (gfc_check_expr_typed): New methods.
* array.c (match_array_element_spec): Check that bounds-expressions
don't have symbols not-yet-typed in them.
* decl.c (var_element): Check that variable used is already typed.
(char_len_param_value): Check that expression does not contain
not-yet-typed symbols.
(in_prefix): New global.
(gfc_match_prefix): Record using `in_prefix' if we're at the moment
parsing a prefix or not.
* expr.c (gfc_expr_check_typed): New method.
* parse.c (verify_st_order): New argument to disable error output.
(check_function_result_typed): New helper method.
(parse_spec): Check that the function-result declaration, if given in
a prefix, contains no not-yet-typed symbols when the IMPLICIT rules are
parsed.
* symbol.c (gfc_check_symbol_typed): Check that a symbol already has
a type associated to it, otherwise use the IMPLICIT rules or signal
an error.
2008-08-22 Daniel Kraft <d@domob.eu>
PR fortran/32095
PR fortran/34228
* gfortran.dg/used_before_typed_1.f90: New test.
* gfortran.dg/used_before_typed_2.f90: New test.
* gfortran.dg/used_before_typed_3.f90: New test.
* gfortran.dg/array_constructor_26.f03: Add -std=gnu to not enable
legacy-behaviour for the new check.
* gfortran.dg/array_constructor_27.f03: Ditto.
* gfortran.dg/blockdata_4.f90: Ditto.
* gfortran.dg/bound_2.f90: Reordered declarations to satisfy the check.
* gfortran.dg/result_in_spec_1.f90: Ditto.
* gfortran.dg/argument_checking_7.f90: Adapted expected error messages.
From-SVN: r139425
Diffstat (limited to 'gcc/fortran/parse.c')
-rw-r--r-- | gcc/fortran/parse.c | 89 |
1 files changed, 80 insertions, 9 deletions
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 965e733..815dbc6 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -1576,7 +1576,7 @@ typedef struct st_state; static gfc_try -verify_st_order (st_state *p, gfc_statement st) +verify_st_order (st_state *p, gfc_statement st, bool silent) { switch (st) @@ -1660,9 +1660,10 @@ verify_st_order (st_state *p, gfc_statement st) return SUCCESS; order: - gfc_error ("%s statement at %C cannot follow %s statement at %L", - gfc_ascii_statement (st), - gfc_ascii_statement (p->last_statement), &p->where); + if (!silent) + gfc_error ("%s statement at %C cannot follow %s statement at %L", + gfc_ascii_statement (st), + gfc_ascii_statement (p->last_statement), &p->where); return FAILURE; } @@ -2169,6 +2170,26 @@ match_deferred_characteristics (gfc_typespec * ts) } +/* Check specification-expressions in the function result of the currently + parsed block and ensure they are typed (give an IMPLICIT type if necessary). + For return types specified in a FUNCTION prefix, the IMPLICIT rules of the + scope are not yet parsed so this has to be delayed up to parse_spec. */ + +static void +check_function_result_typed (void) +{ + gfc_typespec* ts = &gfc_current_ns->proc_name->result->ts; + + gcc_assert (gfc_current_state () == COMP_FUNCTION); + gcc_assert (ts->type != BT_UNKNOWN); + + /* Check type-parameters, at the moment only CHARACTER lengths possible. */ + /* TODO: Extend when KIND type parameters are implemented. */ + if (ts->type == BT_CHARACTER && ts->cl && ts->cl->length) + gfc_expr_check_typed (ts->cl->length, gfc_current_ns, true); +} + + /* Parse a set of specification statements. Returns the statement that doesn't fit. */ @@ -2176,19 +2197,70 @@ static gfc_statement parse_spec (gfc_statement st) { st_state ss; + bool function_result_typed = false; bool bad_characteristic = false; gfc_typespec *ts; - verify_st_order (&ss, ST_NONE); + verify_st_order (&ss, ST_NONE, false); if (st == ST_NONE) st = next_statement (); + /* If we are not inside a function or don't have a result specified so far, + do nothing special about it. */ + if (gfc_current_state () != COMP_FUNCTION) + function_result_typed = true; + else + { + gfc_symbol* proc = gfc_current_ns->proc_name; + gcc_assert (proc); + + if (proc->result->ts.type == BT_UNKNOWN) + function_result_typed = true; + } + loop: + + /* If we find a statement that can not be followed by an IMPLICIT statement + (and thus we can expect to see none any further), type the function result + if it has not yet been typed. Be careful not to give the END statement + to verify_st_order! */ + if (!function_result_typed && st != ST_GET_FCN_CHARACTERISTICS) + { + bool verify_now = false; + + if (st == ST_END_FUNCTION) + verify_now = true; + else + { + st_state dummyss; + verify_st_order (&dummyss, ST_NONE, false); + verify_st_order (&dummyss, st, false); + + if (verify_st_order (&dummyss, ST_IMPLICIT, true) == FAILURE) + verify_now = true; + } + + if (verify_now) + { + check_function_result_typed (); + function_result_typed = true; + } + } + switch (st) { case ST_NONE: unexpected_eof (); + case ST_IMPLICIT_NONE: + case ST_IMPLICIT: + if (!function_result_typed) + { + check_function_result_typed (); + function_result_typed = true; + } + goto declSt; + case ST_FORMAT: case ST_ENTRY: case ST_DATA: /* Not allowed in interfaces */ @@ -2199,14 +2271,13 @@ loop: case ST_USE: case ST_IMPORT: - case ST_IMPLICIT_NONE: - case ST_IMPLICIT: case ST_PARAMETER: case ST_PUBLIC: case ST_PRIVATE: case ST_DERIVED_DECL: case_decl: - if (verify_st_order (&ss, st) == FAILURE) +declSt: + if (verify_st_order (&ss, st, false) == FAILURE) { reject_statement (); st = next_statement (); @@ -2295,7 +2366,7 @@ loop: gfc_current_block ()->ts.kind = 0; /* Keep the derived type; if it's bad, it will be discovered later. */ if (!(ts->type == BT_DERIVED && ts->derived)) - ts->type = BT_UNKNOWN; + ts->type = BT_UNKNOWN; } return st; |