OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/82173 ([meta-bug] Parameterized derived type errors)

Browse Source 
2017-09-12  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/82173
	PR fortran/82168
	* decl.c (variable_decl): Check pdt template components for
	appearance of KIND/LEN components in the type parameter name
	list, that components corresponding to type parameters have
	either KIND or LEN attributes and that KIND or LEN components
	are scalar. Copy the initializer to the parameter value.
	(gfc_get_pdt_instance): Add a label 'error_return' and follow
	it with repeated code, while replacing this code with a jump.
	Check if a parameter appears as a component in the template.
	Make sure that the parameter expressions are integer. Validate
	KIND expressions.
	(gfc_match_decl_type_spec): Search for pdt_types in the parent
	namespace since they are instantiated in the template ns.
	* expr.c (gfc_extract_int): Use a KIND parameter if it
	appears as a component expression.
	(gfc_check_init_expr): Allow expressions with the pdt_kind
	attribute.
	*primary.c (gfc_match_actual_arglist): Make sure that the first
	keyword argument is recognised when 'pdt' is set.


2017-09-12  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/82173
	* gfortran.dg/pdt_4.f03 : Remove the 'is being used before it
	is defined' error.
	* gfortran.dg/pdt_6.f03 : New test.
	* gfortran.dg/pdt_7.f03 : New test.
	* gfortran.dg/pdt_8.f03 : New test.

	PR fortran/82168
	* gfortran.dg/pdt_9.f03 : New test.

From-SVN: r252039
This commit is contained in:
Paul Thomas 2017-09-12 18:06:52 +00:00
parent 29788f9070
commit 18a4e7e305
11 changed files with 303 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
gcc/fortran/ChangeLog
View File

@ -1,3 +1,26 @@
2017-09-12 Paul Thomas <pault@gcc.gnu.org>
PR fortran/82173
PR fortran/82168
* decl.c (variable_decl): Check pdt template components for
appearance of KIND/LEN components in the type parameter name
list, that components corresponding to type parameters have
either KIND or LEN attributes and that KIND or LEN components
are scalar. Copy the initializer to the parameter value.
(gfc_get_pdt_instance): Add a label 'error_return' and follow
it with repeated code, while replacing this code with a jump.
Check if a parameter appears as a component in the template.
Make sure that the parameter expressions are integer. Validate
KIND expressions.
(gfc_match_decl_type_spec): Search for pdt_types in the parent
namespace since they are instantiated in the template ns.
* expr.c (gfc_extract_int): Use a KIND parameter if it
appears as a component expression.
(gfc_check_init_expr): Allow expressions with the pdt_kind
attribute.
*primary.c (gfc_match_actual_arglist): Make sure that the first
keyword argument is recognised when 'pdt' is set.
2017-09-10 Paul Thomas <pault@gcc.gnu.org>
PR fortran/34640

110
gcc/fortran/decl.c
View File

@ -2537,6 +2537,39 @@ variable_decl (int elem)
goto cleanup;
}
if (gfc_current_state () == COMP_DERIVED
&& gfc_current_block ()->attr.pdt_template)
{
gfc_symbol *param;
gfc_find_symbol (name, gfc_current_block ()->f2k_derived,
0, &param);
if (!param && (current_attr.pdt_kind || current_attr.pdt_len))
{
gfc_error ("The component with KIND or LEN attribute at %C does not "
"not appear in the type parameter list at %L",
&gfc_current_block ()->declared_at);
m = MATCH_ERROR;
goto cleanup;
}
else if (param && !(current_attr.pdt_kind || current_attr.pdt_len))
{
gfc_error ("The component at %C that appears in the type parameter "
"list at %L has neither the KIND nor LEN attribute",
&gfc_current_block ()->declared_at);
m = MATCH_ERROR;
goto cleanup;
}
else if (as && (current_attr.pdt_kind || current_attr.pdt_len))
{
gfc_error ("The component at %C which is a type parameter must be "
"a scalar");
m = MATCH_ERROR;
goto cleanup;
}
else if (param && initializer)
param->value = gfc_copy_expr (initializer);
}
/* Add the initializer. Note that it is fine if initializer is
NULL here, because we sometimes also need to check if a
declaration *must* have an initialization expression. */
@ -3193,8 +3226,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
{
gfc_error ("The type parameter spec list at %C cannot contain "
"both ASSUMED and DEFERRED parameters");
gfc_free_actual_arglist (type_param_spec_list);
return MATCH_ERROR;
goto error_return;
}
}
@ -3202,10 +3234,27 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
name_seen = true;
param = type_param_name_list->sym;
c1 = gfc_find_component (pdt, param->name, false, true, NULL);
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)
{
if (actual_param && actual_param->spec_type == SPEC_EXPLICIT)
if (!actual_param && !(c1 && c1->initializer))
{
gfc_error ("The type parameter spec list at %C does not contain "
"enough parameter expressions");
goto error_return;
}
else if (!actual_param && c1 && c1->initializer)
kind_expr = gfc_copy_expr (c1->initializer);
else if (actual_param && actual_param->spec_type == SPEC_EXPLICIT)
kind_expr = gfc_copy_expr (actual_param->expr);
}
else
@ -3225,7 +3274,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
{
gfc_error ("The derived parameter '%qs' at %C does not "
"have a default value", param->name);
return MATCH_ERROR;
goto error_return;
}
}
}
@ -3247,6 +3296,17 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
if (kind_expr)
{
/* Variable expressions seem to default to BT_PROCEDURE.
TODO find out why this is and fix it. */
if (kind_expr->ts.type != BT_INTEGER
&& kind_expr->ts.type != BT_PROCEDURE)
{
gfc_error ("The parameter expression at %C must be of "
"INTEGER type and not %s type",
gfc_basic_typename (kind_expr->ts.type));
goto error_return;
}
tail->expr = gfc_copy_expr (kind_expr);
/* Try simplification even for LEN expressions. */
gfc_simplify_expr (tail->expr, 1);
@ -3257,7 +3317,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
if (!param->attr.pdt_kind)
{
if (!name_seen)
if (!name_seen && actual_param)
actual_param = actual_param->next;
if (kind_expr)
{
@ -3273,16 +3333,14 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
{
gfc_error ("The KIND parameter '%qs' at %C cannot either be "
"ASSUMED or DEFERRED", param->name);
gfc_free_actual_arglist (type_param_spec_list);
return MATCH_ERROR;
goto error_return;
}
if (!kind_expr || !gfc_is_constant_expr (kind_expr))
{
gfc_error ("The value for the KIND parameter '%qs' at %C does not "
"reduce to a constant expression", param->name);
gfc_free_actual_arglist (type_param_spec_list);
return MATCH_ERROR;
goto error_return;
}
gfc_extract_int (kind_expr, &kind_value);
@ -3293,12 +3351,19 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
gfc_free_expr (kind_expr);
}
if (!name_seen && actual_param)
{
gfc_error ("The type parameter spec list at %C contains too many "
"parameter expressions");
goto error_return;
}
/* Now we search for the PDT instance 'name'. If it doesn't exist, we
build it, using 'pdt' as a template. */
if (gfc_get_symbol (name, pdt->ns, &instance))
{
gfc_error ("Parameterized derived type at %C is ambiguous");
return MATCH_ERROR;
goto error_return;
}
m = MATCH_YES;
@ -3370,7 +3435,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
gfc_error ("Maximum extension level reached with type %qs at %L",
c2->ts.u.derived->name,
&c2->ts.u.derived->declared_at);
return MATCH_ERROR;
goto error_return;
}
instance->attr.extension = c2->ts.u.derived->attr.extension + 1;
@ -3390,6 +3455,12 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
gfc_insert_kind_parameter_exprs (e);
gfc_extract_int (e, &c2->ts.kind);
gfc_free_expr (e);
if (gfc_validate_kind (c2->ts.type, c2->ts.kind, true) < 0)
{
gfc_error ("Kind %d not supported for type %s at %C",
c2->ts.kind, gfc_basic_typename (c2->ts.type));
goto error_return;
}
}
/* Similarly, set the string length if parameterized. */
@ -3499,6 +3570,10 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
*ext_param_list = type_param_spec_list;
*sym = instance;
return m;
error_return:
gfc_free_actual_arglist (type_param_spec_list);
return MATCH_ERROR;
}
@ -3829,6 +3904,19 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
}
if (sym->generic && !dt_sym)
dt_sym = gfc_find_dt_in_generic (sym);
/* Host associated PDTs can get confused with their constructors
because they ar instantiated in the template's namespace. */
if (!dt_sym)
{
if (gfc_find_symbol (dt_name, NULL, 1, &dt_sym))
{
gfc_error ("Type name %qs at %C is ambiguous", name);
return MATCH_ERROR;
}
if (dt_sym && !dt_sym->attr.pdt_type)
dt_sym = NULL;
}
}
else if (ts->kind == -1)
{

16
gcc/fortran/expr.c
View File

@ -624,6 +624,20 @@ gfc_replace_expr (gfc_expr *dest, gfc_expr *src)
bool
gfc_extract_int (gfc_expr *expr, int *result, int report_error)
{
gfc_ref *ref;
/* A KIND component is a parameter too. The expression for it
is stored in the initializer and should be consistent with
the tests below. */
if (gfc_expr_attr(expr).pdt_kind)
{
for (ref = expr->ref; ref; ref = ref->next)
{
if (ref->u.c.component->attr.pdt_kind)
expr = ref->u.c.component->initializer;
}
}
if (expr->expr_type != EXPR_CONSTANT)
{
if (report_error > 0)
@ -2548,7 +2562,7 @@ gfc_check_init_expr (gfc_expr *e)
t = true;
/* This occurs when parsing pdt templates. */
if (e->symtree->n.sym->attr.pdt_kind)
if (gfc_expr_attr (e).pdt_kind)
break;
if (gfc_check_iter_variable (e))

14
gcc/fortran/primary.c
View File

@ -1796,11 +1796,6 @@ gfc_match_actual_arglist (int sub_flag, gfc_actual_arglist **argp, bool pdt)
if (sub_flag && !pdt && gfc_match_char ('*') == MATCH_YES)
{
if (pdt)
{
tail->spec_type = SPEC_ASSUMED;
goto next;
}
m = gfc_match_st_label (&label);
if (m == MATCH_NO)
gfc_error ("Expected alternate return label at %C");
@ -1829,6 +1824,15 @@ gfc_match_actual_arglist (int sub_flag, gfc_actual_arglist **argp, bool pdt)
}
else
tail->spec_type = SPEC_EXPLICIT;
m = match_keyword_arg (tail, head, pdt);
if (m == MATCH_YES)
{
seen_keyword = 1;
goto next;
}
if (m == MATCH_ERROR)
goto cleanup;
}
/* After the first keyword argument is seen, the following

12
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,15 @@
2017-09-12 Paul Thomas <pault@gcc.gnu.org>
PR fortran/82173
* gfortran.dg/pdt_4.f03 : Remove the 'is being used before it
is defined' error.
* gfortran.dg/pdt_6.f03 : New test.
* gfortran.dg/pdt_7.f03 : New test.
* gfortran.dg/pdt_8.f03 : New test.
PR fortran/82168
* gfortran.dg/pdt_9.f03 : New test.
2017-09-12 Jakub Jelinek <jakub@redhat.com>
PR target/82112

4
gcc/testsuite/gfortran.dg/pdt_4.f03
View File

@ -81,8 +81,8 @@ end module
end select
deallocate (cz)
contains
subroutine foo(arg) ! { dg-error "has no IMPLICIT type" }
type (mytype(4, *)) :: arg ! { dg-error "is being used before it is defined" }
subroutine foo(arg)
type (mytype(4, *)) :: arg ! used to have an invalid "is being used before it is defined"
end subroutine
subroutine bar(arg) ! { dg-error "cannot have DEFERRED type parameters" }
type (thytype(8, :, 4) :: arg

26
gcc/testsuite/gfortran.dg/pdt_6.f03 Normal file
View File

@ -0,0 +1,26 @@
! { dg-do compile }
!
! Fixes of ICE on invalid & accepts invalid
!
! Contributed by Janus Weil <janus@gcc.gnu.org>
!
implicit none
type :: param_matrix(c,r)
integer, len :: c,r
real :: m(c,r)
end type
type real_array(k)
integer, kind :: k
real(kind=k), allocatable :: r(:)
end type
type(param_matrix(1)) :: m1 ! { dg-error "does not contain enough parameter" }
type(param_matrix(1,2)) :: m2 ! ok
type(param_matrix(1,2,3)) :: m3 ! { dg-error "contains too many parameter" }
type(param_matrix(1,2.5)) :: m4 ! { dg-error "must be of INTEGER type" }
type(real_array(4)) :: a1 ! ok
type(real_array(5)) :: a2 ! { dg-error "Kind 5 not supported for type REAL" }
end

20
gcc/testsuite/gfortran.dg/pdt_7.f03 Normal file
View File

@ -0,0 +1,20 @@
! { dg-do run }
!
! Rejected valid
!
! ! Contributed by Janus Weil <janus@gcc.gnu.org>
!
implicit none
type :: param_matrix(k,c,r)
integer, kind :: k
integer, len :: c,r
real(kind=k) :: m(c,r)
end type
type(param_matrix(8,3,2)) :: mat
real(kind=mat%k) :: m ! Corrected error: Parameter ‘mat’ at (1) has not been declared or ...
if (kind(m) .ne. 8) call abort
end

23
gcc/testsuite/gfortran.dg/pdt_8.f03 Normal file
View File

@ -0,0 +1,23 @@
! { dg-do compile }
!
! Fixes of "accepts invalid".
! Note that the undeclared parameter 'y' in 't1' was originally in the
! type 't'. It turned out to be convenient to defer the error until the
! type is used in the declaration of 'z'.
!
! Contributed by Janus Weil <janus@gcc.gnu.org>
!
implicit none
type :: t(i,a,x) ! { dg-error "does not|has neither" }
integer, kind :: k ! { dg-error "does not not appear in the type parameter list" }
integer :: i ! { dg-error "has neither the KIND nor LEN attribute" }
integer, kind :: a(3) ! { dg-error "must be a scalar" }
real, kind :: x ! { dg-error "must be INTEGER" }
end type
type :: t1(k,y) ! { dg-error "not declared as a component of the type" }
integer, kind :: k
end type
type(t1(4,4)) :: z
end

23
gcc/testsuite/gfortran.dg/pdt_9.f03 Normal file
View File

@ -0,0 +1,23 @@
! { dg-do compile }
!
! Test the fix for PR82168 in which the declarations for 'a'
! and 'b' threw errors even though they are valid.
!
! Contributed by <physiker@toast2.net>
!
module mod
implicit none
integer, parameter :: dp = kind (0.0d0)
type, public :: v(z, k)
integer, len :: z
integer, kind :: k = kind(0.0)
real(kind = k) :: e(z)
end type v
end module mod
program bug
use mod
implicit none
type (v(2)) :: a ! Missing parameter replaced by initializer.
type (v(z=:, k=dp)), allocatable :: b ! Keyword was not working for '*' or ':'
end program bug