From 9775a921e0fb21cdd92ba3c26e603661865a5899 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 27 Jan 2012 14:02:54 +0100 Subject: [PATCH] re PR fortran/52016 ([OOP] Polymorphism and elemental: missing diagnostic) 2012-01-27 Tobias Burnus PR fortran/52016 * resolve.c (resolve_formal_arglist): Fix elemental constraint checks for polymorphic dummies. 2012-01-27 Tobias Burnus PR fortran/52016 * gfortran.dg/elemental_args_check_5.f90: New. From-SVN: r183620 --- gcc/fortran/ChangeLog | 12 +++++++- gcc/fortran/resolve.c | 21 +++++++++++-- gcc/testsuite/ChangeLog | 5 ++++ .../gfortran.dg/elemental_args_check_5.f90 | 30 +++++++++++++++++++ 4 files changed, 64 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/elemental_args_check_5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1dcbfeaa0cd..675c6eed6bb 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2012-01-27 Tobias Burnus + + PR fortran/52016 + * resolve.c (resolve_formal_arglist): Fix elemental + constraint checks for polymorphic dummies. + 2012-01-27 Paul Thomas Tobias Burnus @@ -24,7 +30,11 @@ gfc_copy_class_to_clasfc_cs, to copy to the allocated data. * trans.h : Prototypes for gfc_get_class_array_ref, gfc_copy_class_to_class and gfc_conv_class_to_class. - + +2012-01-25 Tobias Burnus + + * resolve.c (symbol_as): Check also for attr.class_ok. + 2012-01-25 Tobias Burnus PR fortran/51995 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index b24399d6a3f..9bd5c00b33b 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -374,21 +374,26 @@ resolve_formal_arglist (gfc_symbol *proc) if (gfc_elemental (proc)) { /* F08:C1289. */ - if (sym->attr.codimension) + if (sym->attr.codimension + || (sym->ts.type == BT_CLASS && CLASS_DATA (sym) + && CLASS_DATA (sym)->attr.codimension)) { gfc_error ("Coarray dummy argument '%s' at %L to elemental " "procedure", sym->name, &sym->declared_at); continue; } - if (sym->as != NULL) + if (sym->as || (sym->ts.type == BT_CLASS && CLASS_DATA (sym) + && CLASS_DATA (sym)->as)) { gfc_error ("Argument '%s' of elemental procedure at %L must " "be scalar", sym->name, &sym->declared_at); continue; } - if (sym->attr.allocatable) + if (sym->attr.allocatable + || (sym->ts.type == BT_CLASS && CLASS_DATA (sym) + && CLASS_DATA (sym)->attr.allocatable)) { gfc_error ("Argument '%s' of elemental procedure at %L cannot " "have the ALLOCATABLE attribute", sym->name, @@ -1575,6 +1580,16 @@ resolve_procedure_expression (gfc_expr* expr) } +gfc_array_spec * +symbol_as (gfc_symbol *sym) +{ + if (sym->ts.type == BT_CLASS && sym->attr.class_ok) + return CLASS_DATA (sym)->as; + else + return sym->as; +} + + /* Resolve an actual argument list. Most of the time, this is just resolving the expressions in the list. The exception is that we sometimes have to decide whether arguments diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index bdd2792e388..b3440a03a84 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-01-27 Tobias Burnus + + PR fortran/52016 + * gfortran.dg/elemental_args_check_5.f90: New. + 2012-01-27 Richard Guenther PR middle-end/51959 diff --git a/gcc/testsuite/gfortran.dg/elemental_args_check_5.f90 b/gcc/testsuite/gfortran.dg/elemental_args_check_5.f90 new file mode 100644 index 00000000000..d7445c08395 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/elemental_args_check_5.f90 @@ -0,0 +1,30 @@ +! { dg-do compile } +! { dg-options "-fcoarray=single" } +! +! + type t + end type t + type t2 + end type t2 +contains +elemental subroutine foo0(v) ! OK + class(t), intent(in) :: v +end subroutine + +elemental subroutine foo1(w) ! { dg-error "Argument 'w' of elemental procedure at .1. cannot have the ALLOCATABLE attribute" } + class(t), allocatable, intent(in) :: w +end subroutine + +elemental subroutine foo2(x) ! { dg-error "Argument 'x' of elemental procedure at .1. cannot have the POINTER attribute" } + class(t), pointer, intent(in) :: x +end subroutine + +elemental subroutine foo3(y) ! { dg-error "Coarray dummy argument 'y' at .1. to elemental procedure" } + class(t2), intent(in) :: y[*] +end subroutine + +elemental subroutine foo4(z) ! { dg-error "Argument 'z' of elemental procedure at .1. must be scalar" } + class(t), intent(in) :: z(:) +end subroutine + +end -- 2.30.2