This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
Other format: | [Raw text] |
>> The patch looks ok to me. ?Paul or tobias may have a comment, >> so you may want to give them a day or two to respond. >> >> Here's a few rather minor comments. ?In that the comments are >> minor, feel free to ignore them. > > Thanks, Steve and Daniel, for your comments. I have incorporated all > of them (updated patch attached), in particular: > > * I made gfc_type_compatible bool, and used Daniel's gfc_get_super_type inside. > * I renamed match_intrinsic_typespec to match_type_spec, and > gfc_match_type_spec to gfc_match_decl_type_spec, and adjusted the > documentation. I made another small addition to the patch, which I forgot in my CLASS parsing/resolution patch: Rejecting CLASS statements with -std=f95. The attached version of the patch (this time complete with ChangeLog and test cases) regtests fine. Will commit soon ... Cheers, Janus 2009-08-31 Janus Weil <janus@gcc.gnu.org> PR fortran/40940 * array.c (gfc_match_array_constructor): Rename gfc_match_type_spec. * decl.c (gfc_match_type_spec): Rename to gfc_match_decl_type_spec, and reject CLASS with -std=f95. (gfc_match_implicit, gfc_match_data_decl,gfc_match_prefix, match_procedure_interface): Rename gfc_match_type_spec. * gfortran.h (gfc_type_compatible): Add prototype. * match.h (gfc_match_type_spec): Rename to gfc_match_decl_type_spec. * match.c (match_intrinsic_typespec): Rename to match_type_spec, and add handling of derived types. (gfc_match_allocate): Rename match_intrinsic_typespec and check type compatibility of derived types. * symbol.c (gfc_type_compatible): New function to check if two types are compatible. 2009-08-31 Janus Weil <janus@gcc.gnu.org> PR fortran/40940 * gfortran.dg/allocate_derived_1.f90: New. * gfortran.dg/class_3.f03: New.
Index: gcc/fortran/symbol.c =================================================================== --- gcc/fortran/symbol.c (revision 151241) +++ gcc/fortran/symbol.c (working copy) @@ -4534,6 +4534,32 @@ gfc_get_derived_super_type (gfc_symbol* } +/* Check if two typespecs are type compatible (F03:5.1.1.2): + If ts1 is nonpolymorphic, ts2 must be the same type. + If ts1 is polymorphic (CLASS), ts2 must be an extension of ts1. */ + +bool +gfc_type_compatible (gfc_typespec *ts1, gfc_typespec *ts2) +{ + if (ts1->type == BT_DERIVED && ts2->type == BT_DERIVED) + { + gfc_symbol *t0, *t; + if (ts1->is_class) + { + t0 = ts1->u.derived; + t = ts2->u.derived; + while (t0 != t && t->attr.extension) + t = gfc_get_derived_super_type (t); + return (t0 == t); + } + else + return (ts1->u.derived == ts2->u.derived); + } + else + return (ts1->type == ts2->type); +} + + /* General worker function to find either a type-bound procedure or a type-bound user operator. */ Index: gcc/fortran/decl.c =================================================================== --- gcc/fortran/decl.c (revision 151241) +++ gcc/fortran/decl.c (working copy) @@ -2267,8 +2267,8 @@ done: } -/* Matches a type specification. If successful, sets the ts structure - to the matched specification. This is necessary for FUNCTION and +/* Matches a declaration-type-spec (F03:R502). If successful, sets the ts + structure to the matched specification. This is necessary for FUNCTION and IMPLICIT statements. If implicit_flag is nonzero, then we don't check for the optional @@ -2276,7 +2276,7 @@ done: statement correctly. */ match -gfc_match_type_spec (gfc_typespec *ts, int implicit_flag) +gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) { char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_symbol *sym; @@ -2377,6 +2377,10 @@ gfc_match_type_spec (gfc_typespec *ts, i return m; ts->is_class = 1; + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: CLASS statement at %C") + == FAILURE) + return MATCH_ERROR; + /* TODO: Implement Polymorphism. */ gfc_warning ("Polymorphic entities are not yet implemented. " "CLASS will be treated like TYPE at %C"); @@ -2599,7 +2603,7 @@ gfc_match_implicit (void) gfc_clear_new_implicit (); /* A basic type is mandatory here. */ - m = gfc_match_type_spec (&ts, 1); + m = gfc_match_decl_type_spec (&ts, 1); if (m == MATCH_ERROR) goto error; if (m == MATCH_NO) @@ -3675,7 +3679,7 @@ gfc_match_data_decl (void) num_idents_on_line = 0; - m = gfc_match_type_spec (¤t_ts, 0); + m = gfc_match_decl_type_spec (¤t_ts, 0); if (m != MATCH_YES) return m; @@ -3780,7 +3784,7 @@ gfc_match_prefix (gfc_typespec *ts) loop: if (!seen_type && ts != NULL - && gfc_match_type_spec (ts, 0) == MATCH_YES + && gfc_match_decl_type_spec (ts, 0) == MATCH_YES && gfc_match_space () == MATCH_YES) { @@ -4178,7 +4182,7 @@ match_procedure_interface (gfc_symbol ** /* Get the type spec. for the procedure interface. */ old_loc = gfc_current_locus; - m = gfc_match_type_spec (¤t_ts, 0); + m = gfc_match_decl_type_spec (¤t_ts, 0); gfc_gobble_whitespace (); if (m == MATCH_YES || (m == MATCH_NO && gfc_peek_ascii_char () == ')')) goto got_ts; Index: gcc/fortran/array.c =================================================================== --- gcc/fortran/array.c (revision 151241) +++ gcc/fortran/array.c (working copy) @@ -907,7 +907,7 @@ gfc_match_array_constructor (gfc_expr ** seen_ts = false; /* Try to match an optional "type-spec ::" */ - if (gfc_match_type_spec (&ts, 0) == MATCH_YES) + if (gfc_match_decl_type_spec (&ts, 0) == MATCH_YES) { seen_ts = (gfc_match (" ::") == MATCH_YES); Index: gcc/fortran/gfortran.h =================================================================== --- gcc/fortran/gfortran.h (revision 151241) +++ gcc/fortran/gfortran.h (working copy) @@ -2469,6 +2469,7 @@ gfc_gsymbol *gfc_find_gsymbol (gfc_gsymb gfc_typebound_proc* gfc_get_typebound_proc (void); gfc_symbol* gfc_get_derived_super_type (gfc_symbol*); +bool gfc_type_compatible (gfc_typespec *, gfc_typespec *); gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, gfc_try*, const char*, bool, locus*); gfc_symtree* gfc_find_typebound_user_op (gfc_symbol*, gfc_try*, Index: gcc/fortran/match.c =================================================================== --- gcc/fortran/match.c (revision 151241) +++ gcc/fortran/match.c (working copy) @@ -2221,21 +2221,22 @@ gfc_free_alloc_list (gfc_alloc *p) } -/* Match a Fortran 2003 intrinsic-type-spec. This is a stripped - down version of gfc_match_type_spec() from decl.c. It only includes - the intrinsic types from the Fortran 2003 standard. Thus, neither - BYTE nor forms like REAL*4 are allowed. Additionally, the implicit_flag - is not needed, so it was removed. The handling of derived types has - been removed and no notion of the gfc_matching_function state - is needed. In short, this functions matches only standard conforming - intrinsic-type-spec (R403). */ +/* Match a Fortran 2003 type-spec (F03:R401). This is similar to + gfc_match_decl_type_spec() from decl.c, with the following exceptions: + It only includes the intrinsic types from the Fortran 2003 standard + (thus, neither BYTE nor forms like REAL*4 are allowed). Additionally, + the implicit_flag is not needed, so it was removed. Derived types are + identified by their name alone. */ static match -match_intrinsic_typespec (gfc_typespec *ts) +match_type_spec (gfc_typespec *ts) { match m; + gfc_symbol *derived; + locus old_locus; gfc_clear_ts (ts); + old_locus = gfc_current_locus; if (gfc_match ("integer") == MATCH_YES) { @@ -2278,7 +2279,43 @@ match_intrinsic_typespec (gfc_typespec * goto kind_selector; } - /* If an intrinsic type is not matched, simply return MATCH_NO. */ + if (gfc_match_symbol (&derived, 1) == MATCH_YES) + { + if (derived->attr.flavor == FL_DERIVED) + { + old_locus = gfc_current_locus; + if (gfc_match (" :: ") != MATCH_YES) + return MATCH_ERROR; + gfc_current_locus = old_locus; + ts->type = BT_DERIVED; + ts->u.derived = derived; + /* Enfore F03:C401. */ + if (derived->attr.abstract) + { + gfc_error ("Derived type '%s' at %L may not be ABSTRACT", + derived->name, &old_locus); + return MATCH_ERROR; + } + return MATCH_YES; + } + else + { + if (gfc_match (" :: ") == MATCH_YES) + { + /* Enforce F03:C476. */ + gfc_error ("'%s' at %L is not an accessible derived type", + derived->name, &old_locus); + return MATCH_ERROR; + } + else + { + gfc_current_locus = old_locus; + return MATCH_NO; + } + } + } + + /* If a type is not matched, simply return MATCH_NO. */ return MATCH_NO; kind_selector: @@ -2379,9 +2416,9 @@ gfc_match_allocate (void) if (gfc_match_char ('(') != MATCH_YES) goto syntax; - /* Match an optional intrinsic-type-spec. */ + /* Match an optional type-spec. */ old_locus = gfc_current_locus; - m = match_intrinsic_typespec (&ts); + m = match_type_spec (&ts); if (m == MATCH_ERROR) goto cleanup; else if (m == MATCH_NO) @@ -2430,15 +2467,15 @@ gfc_match_allocate (void) constraints. */ if (ts.type != BT_UNKNOWN) { - /* Enforce C626. */ - if (ts.type != tail->expr->ts.type) + /* Enforce F03:C624. */ + if (!gfc_type_compatible (&tail->expr->ts, &ts)) { gfc_error ("Type of entity at %L is type incompatible with " "typespec", &tail->expr->where); goto cleanup; } - /* Enforce C627. */ + /* Enforce F03:C627. */ if (ts.kind != tail->expr->ts.kind) { gfc_error ("Kind type parameter for entity at %L differs from " Index: gcc/fortran/match.h =================================================================== --- gcc/fortran/match.h (revision 151241) +++ gcc/fortran/match.h (working copy) @@ -138,7 +138,7 @@ match gfc_match_data (void); match gfc_match_null (gfc_expr **); match gfc_match_kind_spec (gfc_typespec *, bool); match gfc_match_old_kind_spec (gfc_typespec *); -match gfc_match_type_spec (gfc_typespec *, int); +match gfc_match_decl_type_spec (gfc_typespec *, int); match gfc_match_end (gfc_statement *); match gfc_match_data_decl (void);
Attachment:
allocate_derived_1.f90
Description: Binary data
Attachment:
class_3.f03
Description: Binary data
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |