Skip to content

R
riscv-gcc-1
Commit de624bee by Paul Thomas
Options

re PR fortran/82586 ([PDT] ICE: write_symbol(): bad module symbol) 

2017-10-21  Paul Thomas  <pault@gcc.gnu.org>

	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  <pault@gcc.gnu.org>

	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
parent aa93ca09
Showing with 144 additions and 15 deletions
gcc/fortran/ChangeLog
2017-10-21 Paul Thomas <pault@gcc.gnu.org>
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 <aldot@gcc.gnu.org>
* interface.c (check_sym_interfaces, check_uop_interfaces,
......
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;
}
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,6 +5996,10 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag,
m = gfc_match_char (',');
if (m != MATCH_YES)
{
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;
......
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);
......
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
......
gcc/testsuite/ChangeLog
2017-10-21 Paul Thomas <pault@gcc.gnu.org>
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 <igor.v.tsimbalist@intel.com>
* c-c++-common/fcf-protection-1.c: New test.
......
gcc/testsuite/gfortran.dg/pdt_16.f03 0 → 100644
! { dg-do compile }
!
! Test the fix for all three errors in PR82586
!
! Contributed by G Steinmetz <gscfq@t-online.de>
!
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
gcc/testsuite/gfortran.dg/pdt_17.f03 0 → 100644
! { dg-do compile }
!
! Test the fix for PR82587
!
! Contributed by G Steinmetz <gscfq@t-online.de>
!
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
gcc/testsuite/gfortran.dg/pdt_18.f03 0 → 100644
! { dg-do compile }
!
! Test the fix for PR82589
!
! Contributed by G Steinmetz <gscfq@t-online.de>
!
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
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" }
......
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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment