From de624beeae1b049b6bd834b28980e6ce9891d45d Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 21 Oct 2017 09:02:17 +0000 Subject: [PATCH] re PR fortran/82586 ([PDT] ICE: write_symbol(): bad module symbol) 2017-10-21 Paul Thomas PR fortran/82586 * decl.c (gfc_get_pdt_instance): Remove the error message that the parameter does not have a corresponding component since this is now taken care of when the derived type is resolved. Go straight to error return instead. (gfc_match_formal_arglist): Make the PDT relevant errors immediate so that parsing of the derived type can continue. (gfc_match_derived_decl): Do not check the match status on return from gfc_match_formal_arglist for the same reason. * resolve.c (resolve_fl_derived0): Check that each type parameter has a corresponding component. PR fortran/82587 * resolve.c (resolve_generic_f): Check that the derived type can be used before resolving the struture constructor. PR fortran/82589 * symbol.c (check_conflict): Add the conflicts involving PDT KIND and LEN attributes. 2017-10-21 Paul Thomas PR fortran/82586 * gfortran.dg/pdt_16.f03 : New test. * gfortran.dg/pdt_4.f03 : Catch the changed messages. * gfortran.dg/pdt_8.f03 : Ditto. PR fortran/82587 * gfortran.dg/pdt_17.f03 : New test. PR fortran/82589 * gfortran.dg/pdt_18.f03 : New test. From-SVN: r253970 --- gcc/fortran/ChangeLog | 22 ++++++++++++++++++++ gcc/fortran/decl.c | 31 ++++++++++++++++------------ gcc/fortran/resolve.c | 19 +++++++++++++++++ gcc/fortran/symbol.c | 20 +++++++++++++++++- gcc/testsuite/ChangeLog | 13 ++++++++++++ gcc/testsuite/gfortran.dg/pdt_16.f03 | 21 +++++++++++++++++++ gcc/testsuite/gfortran.dg/pdt_17.f03 | 11 ++++++++++ gcc/testsuite/gfortran.dg/pdt_18.f03 | 19 +++++++++++++++++ gcc/testsuite/gfortran.dg/pdt_4.f03 | 2 +- gcc/testsuite/gfortran.dg/pdt_8.f03 | 5 +++-- 10 files changed, 146 insertions(+), 17 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pdt_16.f03 create mode 100644 gcc/testsuite/gfortran.dg/pdt_17.f03 create mode 100644 gcc/testsuite/gfortran.dg/pdt_18.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 962dbe888f6..6bf4f1d566d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,25 @@ +2017-10-21 Paul Thomas + + PR fortran/82586 + * decl.c (gfc_get_pdt_instance): Remove the error message that + the parameter does not have a corresponding component since + this is now taken care of when the derived type is resolved. Go + straight to error return instead. + (gfc_match_formal_arglist): Make the PDT relevant errors + immediate so that parsing of the derived type can continue. + (gfc_match_derived_decl): Do not check the match status on + return from gfc_match_formal_arglist for the same reason. + * resolve.c (resolve_fl_derived0): Check that each type + parameter has a corresponding component. + + PR fortran/82587 + * resolve.c (resolve_generic_f): Check that the derived type + can be used before resolving the struture constructor. + + PR fortran/82589 + * symbol.c (check_conflict): Add the conflicts involving PDT + KIND and LEN attributes. + 2017-10-19 Bernhard Reutner-Fischer * interface.c (check_sym_interfaces, check_uop_interfaces, diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 5bf56c4d4b0..1a2d8f004ca 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -3242,13 +3242,10 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, param = type_param_name_list->sym; c1 = gfc_find_component (pdt, param->name, false, true, NULL); + /* An error should already have been thrown in resolve.c + (resolve_fl_derived0). */ if (!pdt->attr.use_assoc && !c1) - { - gfc_error ("The type parameter name list at %L contains a parameter " - "'%qs' , which is not declared as a component of the type", - &pdt->declared_at, param->name); - goto error_return; - } + goto error_return; kind_expr = NULL; if (!name_seen) @@ -5984,7 +5981,7 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, /* The name of a program unit can be in a different namespace, so check for it explicitly. After the statement is accepted, the name is checked for especially in gfc_get_symbol(). */ - if (gfc_new_block != NULL && sym != NULL + if (gfc_new_block != NULL && sym != NULL && !typeparam && strcmp (sym->name, gfc_new_block->name) == 0) { gfc_error ("Name %qs at %C is the name of the procedure", @@ -5999,7 +5996,11 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, m = gfc_match_char (','); if (m != MATCH_YES) { - gfc_error ("Unexpected junk in formal argument list at %C"); + if (typeparam) + gfc_error_now ("Expected parameter list in type declaration " + "at %C"); + else + gfc_error ("Unexpected junk in formal argument list at %C"); goto cleanup; } } @@ -6016,8 +6017,12 @@ ok: for (q = p->next; q; q = q->next) if (p->sym == q->sym) { - gfc_error ("Duplicate symbol %qs in formal argument list " - "at %C", p->sym->name); + if (typeparam) + gfc_error_now ("Duplicate name %qs in parameter " + "list at %C", p->sym->name); + else + gfc_error ("Duplicate symbol %qs in formal argument " + "list at %C", p->sym->name); m = MATCH_ERROR; goto cleanup; @@ -9814,9 +9819,9 @@ gfc_match_derived_decl (void) if (parameterized_type) { - m = gfc_match_formal_arglist (sym, 0, 0, true); - if (m != MATCH_YES) - return m; + /* Ignore error or mismatches to avoid the component declarations + causing problems later. */ + gfc_match_formal_arglist (sym, 0, 0, true); m = gfc_match_eos (); if (m != MATCH_YES) return m; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 04d4e8ab6cb..5062bcb755a 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2694,6 +2694,8 @@ generic: if (!gfc_convert_to_structure_constructor (expr, intr->sym, NULL, NULL, false)) return false; + if (!gfc_use_derived (expr->ts.u.derived)) + return false; return resolve_structure_cons (expr, 0); } @@ -13937,6 +13939,7 @@ resolve_fl_derived0 (gfc_symbol *sym) { gfc_symbol* super_type; gfc_component *c; + gfc_formal_arglist *f; bool success; if (sym->attr.unlimited_polymorphic) @@ -13989,6 +13992,22 @@ resolve_fl_derived0 (gfc_symbol *sym) && !ensure_not_abstract (sym, super_type)) return false; + /* Check that there is a component for every PDT parameter. */ + if (sym->attr.pdt_template) + { + for (f = sym->formal; f; f = f->next) + { + c = gfc_find_component (sym, f->sym->name, true, true, NULL); + if (c == NULL) + { + gfc_error ("Parameterized type %qs does not have a component " + "corresponding to parameter %qs at %L", sym->name, + f->sym->name, &sym->declared_at); + break; + } + } + } + /* Add derived type to the derived type list. */ add_dt_to_dt_list (sym); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 36abba5a488..11b6f600103 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -426,7 +426,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) *is_bind_c = "BIND(C)", *procedure = "PROCEDURE", *proc_pointer = "PROCEDURE POINTER", *abstract = "ABSTRACT", *asynchronous = "ASYNCHRONOUS", *codimension = "CODIMENSION", - *contiguous = "CONTIGUOUS", *generic = "GENERIC", *automatic = "AUTOMATIC"; + *contiguous = "CONTIGUOUS", *generic = "GENERIC", *automatic = "AUTOMATIC", + *pdt_len = "LEN", *pdt_kind = "KIND"; static const char *threadprivate = "THREADPRIVATE"; static const char *omp_declare_target = "OMP DECLARE TARGET"; static const char *omp_declare_target_link = "OMP DECLARE TARGET LINK"; @@ -707,6 +708,23 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (entry, oacc_declare_deviceptr) conf (entry, oacc_declare_device_resident) + conf (pdt_kind, allocatable) + conf (pdt_kind, pointer) + conf (pdt_kind, dimension) + conf (pdt_kind, codimension) + + conf (pdt_len, allocatable) + conf (pdt_len, pointer) + conf (pdt_len, dimension) + conf (pdt_len, codimension) + + if (attr->access == ACCESS_PRIVATE) + { + a1 = privat; + conf2 (pdt_kind); + conf2 (pdt_len); + } + a1 = gfc_code2string (flavors, attr->flavor); if (attr->in_namelist diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9e0b48d23b8..12f9f6d98c4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,16 @@ +2017-10-21 Paul Thomas + + PR fortran/82586 + * gfortran.dg/pdt_16.f03 : New test. + * gfortran.dg/pdt_4.f03 : Catch the changed messages. + * gfortran.dg/pdt_8.f03 : Ditto. + + PR fortran/82587 + * gfortran.dg/pdt_17.f03 : New test. + + PR fortran/82589 + * gfortran.dg/pdt_18.f03 : New test. + 2017-10-20 Igor Tsimbalist * c-c++-common/fcf-protection-1.c: New test. diff --git a/gcc/testsuite/gfortran.dg/pdt_16.f03 b/gcc/testsuite/gfortran.dg/pdt_16.f03 new file mode 100644 index 00000000000..067d87d660d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_16.f03 @@ -0,0 +1,21 @@ +! { dg-do compile } +! +! Test the fix for all three errors in PR82586 +! +! Contributed by G Steinmetz +! +module m + type t(a) ! { dg-error "does not have a component" } + end type +end + +program p + type t(a ! { dg-error "Expected parameter list" } + integer, kind :: a + real(a) :: x + end type + type u(a, a) ! { dg-error "Duplicate name" } + integer, kind :: a ! { dg-error "already declared" } + integer, len :: a ! { dg-error "already declared" } + end type +end diff --git a/gcc/testsuite/gfortran.dg/pdt_17.f03 b/gcc/testsuite/gfortran.dg/pdt_17.f03 new file mode 100644 index 00000000000..1b0a30dca4c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_17.f03 @@ -0,0 +1,11 @@ +! { dg-do compile } +! +! Test the fix for PR82587 +! +! Contributed by G Steinmetz +! +program p + type t(a) ! { dg-error "does not have a component" } + integer(kind=t()) :: x ! { dg-error "used before it is defined" } + end type +end diff --git a/gcc/testsuite/gfortran.dg/pdt_18.f03 b/gcc/testsuite/gfortran.dg/pdt_18.f03 new file mode 100644 index 00000000000..896a727eaae --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_18.f03 @@ -0,0 +1,19 @@ +! { dg-do compile } +! +! Test the fix for PR82589 +! +! Contributed by G Steinmetz +! +module m + type t(a) + integer, KIND, private :: a ! { dg-error "attribute conflicts with" } + integer, KIND, allocatable :: a ! { dg-error "attribute conflicts with" } + integer, KIND, POINTER :: a ! { dg-error "attribute conflicts with" } + integer, KIND, dimension(2) :: a ! { dg-error "attribute conflicts with" } + integer, len, private :: a ! { dg-error "attribute conflicts with" } + integer, len, allocatable :: a ! { dg-error "attribute conflicts with" } + integer, len, POINTER :: a ! { dg-error "attribute conflicts with" } + integer, len, dimension(2) :: a ! { dg-error "attribute conflicts with" } + integer, kind :: a + end type +end diff --git a/gcc/testsuite/gfortran.dg/pdt_4.f03 b/gcc/testsuite/gfortran.dg/pdt_4.f03 index 13c00af79f1..15cb6417ca7 100644 --- a/gcc/testsuite/gfortran.dg/pdt_4.f03 +++ b/gcc/testsuite/gfortran.dg/pdt_4.f03 @@ -26,7 +26,7 @@ end module integer, kind :: bad_kind ! { dg-error "not allowed outside a TYPE definition" } integer, len :: bad_len ! { dg-error "not allowed outside a TYPE definition" } - type :: bad_pdt (a,b, c, d) + type :: bad_pdt (a,b, c, d) ! { dg-error "does not have a component" } real, kind :: a ! { dg-error "must be INTEGER" } INTEGER(8), kind :: b ! { dg-error "be default integer kind" } real, LEN :: c ! { dg-error "must be INTEGER" } diff --git a/gcc/testsuite/gfortran.dg/pdt_8.f03 b/gcc/testsuite/gfortran.dg/pdt_8.f03 index d5e393e5e0c..aeec407fb4b 100644 --- a/gcc/testsuite/gfortran.dg/pdt_8.f03 +++ b/gcc/testsuite/gfortran.dg/pdt_8.f03 @@ -15,9 +15,10 @@ type :: t(i,a,x) ! { dg-error "does not|has neither" } real, kind :: x ! { dg-error "must be INTEGER" } end type -type :: t1(k,y) ! { dg-error "not declared as a component of the type" } +type :: t1(k,y) ! { dg-error "does not have a component" } integer, kind :: k end type -type(t1(4,4)) :: z +! This is a knock-on from the previous error +type(t1(4,4)) :: z ! { dg-error "Invalid character in name" } end -- 2.30.2