diff options
| author | Tobias Burnus <burnus@net-b.de> | 2012-03-03 09:40:24 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2012-03-03 09:40:24 +0100 |
| commit | 45a6932568c7c3f4aaf0e0c935a5f5d58ecf1919 (patch) | |
| tree | 0c29d6bc5a187e73c40b9223ee82a99a407d2889 /gcc/fortran/decl.c | |
| parent | c0e8830c542d211c6fe1fe3c49a814a46ffc9617 (diff) | |
| download | gcc-45a6932568c7c3f4aaf0e0c935a5f5d58ecf1919.zip gcc-45a6932568c7c3f4aaf0e0c935a5f5d58ecf1919.tar.gz gcc-45a6932568c7c3f4aaf0e0c935a5f5d58ecf1919.tar.bz2 | |
re PR fortran/48820 (TR 29113: Implement parts needed for MPI 3)
2012-03-03 Tobias Burnus <burnus@net-b.de>
PR fortran/48820
* decl.c (gfc_match_decl_type_spec): Support type(*).
(gfc_verify_c_interop): Allow type(*).
* dump-parse-tree.c (show_typespec): Handle type(*).
* expr.c (gfc_copy_expr): Ditto.
* interface.c (compare_type_rank, compare_parameter,
compare_actual_formal, gfc_procedure_use): Ditto.
* libgfortran.h (bt): Add BT_ASSUMED.
* misc.c (gfc_basic_typename, gfc_typename): Handle type(*).
* module.c (bt_types): Ditto.
* resolve.c (assumed_type_expr_allowed): New static variable.
(resolve_actual_arglist, resolve_variable, resolve_symbol):
Handle type(*).
* trans-expr.c (gfc_conv_procedure_call): Ditto.
* trans-types.c (gfc_typenode_for_spec, gfc_get_dtype): Ditto.
2012-03-03 Tobias Burnus <burnus@net-b.de>
PR fortran/48820
* gfortran.dg/assumed_type_1.f90: New.
* gfortran.dg/assumed_type_2.f90: New.
* gfortran.dg/assumed_type_3.f90: New.
* gfortran.dg/assumed_type_4.f90: New.
From-SVN: r184852
Diffstat (limited to 'gcc/fortran/decl.c')
| -rw-r--r-- | gcc/fortran/decl.c | 30 |
1 files changed, 26 insertions, 4 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 43c558a..bdb8c39 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2600,9 +2600,31 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) } - m = gfc_match (" type ( %n", name); + m = gfc_match (" type ("); matched_type = (m == MATCH_YES); - + if (matched_type) + { + gfc_gobble_whitespace (); + if (gfc_peek_ascii_char () == '*') + { + if ((m = gfc_match ("*)")) != MATCH_YES) + return m; + if (gfc_current_state () == COMP_DERIVED) + { + gfc_error ("Assumed type at %C is not allowed for components"); + return MATCH_ERROR; + } + if (gfc_notify_std (GFC_STD_F2008_TS, "TS 29113: Assumed type " + "at %C") == FAILURE) + return MATCH_ERROR; + ts->type = BT_ASSUMED; + return MATCH_YES; + } + + m = gfc_match ("%n", name); + matched_type = (m == MATCH_YES); + } + if ((matched_type && strcmp ("integer", name) == 0) || (!matched_type && gfc_match (" integer") == MATCH_YES)) { @@ -3854,9 +3876,9 @@ gfc_verify_c_interop (gfc_typespec *ts) ? SUCCESS : FAILURE; else if (ts->type == BT_CLASS) return FAILURE; - else if (ts->is_c_interop != 1) + else if (ts->is_c_interop != 1 && ts->type != BT_ASSUMED) return FAILURE; - + return SUCCESS; } |