From 019c0e5dc17205c2a7f302ff83943cb1c3444237 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sun, 8 Dec 2013 22:34:18 +0100 Subject: [PATCH] re PR fortran/58099 ([F03] over-zealous procedure-pointer error checking) 2013-12-08 Tobias Burnus Janus Weil PR fortran/58099 PR fortran/58676 PR fortran/41724 * resolve.c (gfc_resolve_intrinsic): Set elemental/pure. (resolve_fl_procedure): Reject pure dummy procedures/procedure pointers. (gfc_explicit_interface_required): Don't require a match of ELEMENTAL for intrinsics. 2013-12-08 Tobias Burnus PR fortran/58099 PR fortran/58676 PR fortran/41724 * gfortran.dg/elemental_subroutine_8.f90: New. * gfortran.dg/proc_decl_9.f90: Add ELEMENTAL to make valid. * gfortran.dg/proc_ptr_11.f90: Ditto. * gfortran.dg/proc_ptr_result_8.f90: Ditto. * gfortran.dg/proc_ptr_32.f90: Update dg-error. * gfortran.dg/proc_ptr_33.f90: Ditto. * gfortran.dg/proc_ptr_result_1.f90: Add abstract interface which is not elemental. * gfortran.dg/proc_ptr_result_7.f90: Ditto. Co-Authored-By: Janus Weil From-SVN: r205791 --- gcc/fortran/ChangeLog | 12 +++++ gcc/fortran/resolve.c | 22 +++++++- gcc/testsuite/ChangeLog | 15 ++++++ .../gfortran.dg/elemental_subroutine_8.f90 | 50 +++++++++++++++++++ gcc/testsuite/gfortran.dg/proc_decl_9.f90 | 4 +- gcc/testsuite/gfortran.dg/proc_ptr_11.f90 | 17 +++++-- gcc/testsuite/gfortran.dg/proc_ptr_32.f90 | 4 +- gcc/testsuite/gfortran.dg/proc_ptr_33.f90 | 2 +- .../gfortran.dg/proc_ptr_result_1.f90 | 8 ++- .../gfortran.dg/proc_ptr_result_7.f90 | 11 +++- .../gfortran.dg/proc_ptr_result_8.f90 | 13 +++-- 11 files changed, 141 insertions(+), 17 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/elemental_subroutine_8.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4be8725bd0d..1f4e2aa5e4f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2013-12-08 Tobias Burnus + Janus Weil + + PR fortran/58099 + PR fortran/58676 + PR fortran/41724 + * resolve.c (gfc_resolve_intrinsic): Set elemental/pure. + (resolve_fl_procedure): Reject pure dummy procedures/procedure + pointers. + (gfc_explicit_interface_required): Don't require a + match of ELEMENTAL for intrinsics. + 2013-12-07 Janus Weil PR fortran/59414 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 5ed70539a91..ea4632473fc 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1679,6 +1679,9 @@ gfc_resolve_intrinsic (gfc_symbol *sym, locus *loc) gfc_copy_formal_args_intr (sym, isym); + sym->attr.pure = isym->pure; + sym->attr.elemental = isym->elemental; + /* Check it is actually available in the standard settings. */ if (!gfc_check_intrinsic_standard (isym, &symstd, false, sym->declared_at)) { @@ -2314,7 +2317,7 @@ gfc_explicit_interface_required (gfc_symbol *sym, char *errmsg, int err_len) } } - if (sym->attr.elemental) /* (4) */ + if (sym->attr.elemental && !sym->attr.intrinsic) /* (4) */ { strncpy (errmsg, _("elemental procedure"), err_len); return true; @@ -11094,6 +11097,23 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) sym->name, &sym->declared_at); } + /* F2008, C1218. */ + if (sym->attr.elemental) + { + if (sym->attr.proc_pointer) + { + gfc_error ("Procedure pointer '%s' at %L shall not be elemental", + sym->name, &sym->declared_at); + return false; + } + if (sym->attr.dummy) + { + gfc_error ("Dummy procedure '%s' at %L shall not be elemental", + sym->name, &sym->declared_at); + return false; + } + } + if (sym->attr.is_bind_c && sym->attr.is_c_interop != 1) { gfc_formal_arglist *curr_arg; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fc320428699..b6317053b71 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,18 @@ +2013-12-08 Tobias Burnus + + PR fortran/58099 + PR fortran/58676 + PR fortran/41724 + * gfortran.dg/elemental_subroutine_8.f90: New. + * gfortran.dg/proc_decl_9.f90: Add ELEMENTAL to make valid. + * gfortran.dg/proc_ptr_11.f90: Ditto. + * gfortran.dg/proc_ptr_result_8.f90: Ditto. + * gfortran.dg/proc_ptr_32.f90: Update dg-error. + * gfortran.dg/proc_ptr_33.f90: Ditto. + * gfortran.dg/proc_ptr_result_1.f90: Add abstract interface + which is not elemental. + * gfortran.dg/proc_ptr_result_7.f90: Ditto. + 2013-12-07 Janus Weil PR fortran/59414 diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_8.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_8.f90 new file mode 100644 index 00000000000..c557d3a9d95 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/elemental_subroutine_8.f90 @@ -0,0 +1,50 @@ +! { dg-do compile } +! +! PR fortran/58099 +! +! See also interpretation request F03-0130 in 09-217 and 10-006T5r1. +! +! - ELEMENTAL is only permitted for external names with PROCEDURE/INTERFACE +! but not for dummy arguments or proc-pointers +! - Using PROCEDURE with an elemental intrinsic as interface name a is valid, +! but doesn't make the proc-pointer/dummy argument elemental +! + + interface + elemental real function x(y) + real, intent(in) :: y + end function x + end interface + intrinsic :: sin + procedure(x) :: xx1 ! OK + procedure(x), pointer :: xx2 ! { dg-error "Procedure pointer 'xx2' at .1. shall not be elemental" } + procedure(real), pointer :: pp + procedure(sin) :: bar ! OK + procedure(sin), pointer :: foo ! { dg-error "Procedure pointer 'foo' at .1. shall not be elemental" } + pp => sin !OK +contains + subroutine sub1(z) ! { dg-error "Dummy procedure 'z' at .1. shall not be elemental" } + procedure(x) :: z + end subroutine sub1 + subroutine sub2(z) ! { dg-error "Procedure pointer 'z' at .1. shall not be elemental" } + procedure(x), pointer :: z + end subroutine sub2 + subroutine sub3(z) + interface + elemental real function z(y) ! { dg-error "Dummy procedure 'z' at .1. shall not be elemental" } + real, intent(in) :: y + end function z + end interface + end subroutine sub3 + subroutine sub4(z) + interface + elemental real function z(y) ! { dg-error "Procedure pointer 'z' at .1. shall not be elemental" } + real, intent(in) :: y + end function z + end interface + pointer :: z + end subroutine sub4 + subroutine sub5(z) ! { dg-error "Dummy procedure 'z' at .1. shall not be elemental" } + procedure(sin) :: z + end subroutine sub5 +end diff --git a/gcc/testsuite/gfortran.dg/proc_decl_9.f90 b/gcc/testsuite/gfortran.dg/proc_decl_9.f90 index 58ae321899e..455c27ce986 100644 --- a/gcc/testsuite/gfortran.dg/proc_decl_9.f90 +++ b/gcc/testsuite/gfortran.dg/proc_decl_9.f90 @@ -1,7 +1,7 @@ ! { dg-do run } ! PR33162 INTRINSIC functions as ACTUAL argument ! Test case adapted from PR by Jerry DeLisle -real function t(x) +elemental real function t(x) real, intent(in) ::x t = x end function @@ -9,6 +9,6 @@ end function program p implicit none intrinsic sin - procedure(sin):: t + procedure(sin) :: t if (t(1.0) /= 1.0) call abort end program diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_11.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_11.f90 index bee73f45213..61921e78ad0 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_11.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_11.f90 @@ -7,16 +7,23 @@ program bsp implicit none - + intrinsic :: isign, iabs abstract interface subroutine up() end subroutine up + ! As intrinsics but not elemental + pure integer function isign_interf(a, b) + integer, intent(in) :: a, b + end function isign_interf + pure integer function iabs_interf(x) + integer, intent(in) :: x + end function iabs_interf end interface procedure( up ) , pointer :: pptr - procedure(isign), pointer :: q + procedure(isign_interf), pointer :: q - procedure(iabs),pointer :: p1 + procedure(iabs_interf),pointer :: p1 procedure(f), pointer :: p2 pointer :: p3 @@ -48,13 +55,13 @@ program bsp contains - function add( a, b ) + pure function add( a, b ) integer :: add integer, intent( in ) :: a, b add = a + b end function add - integer function f(x) + pure integer function f(x) integer,intent(in) :: x f = 317 + x end function diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_32.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_32.f90 index 9cae65be0d8..9b1ed582bd1 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_32.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_32.f90 @@ -5,8 +5,8 @@ ! Contributed by James Van Buskirk implicit none - procedure(my_dcos), pointer :: f - f => my_dcos ! { dg-error "invalid in procedure pointer assignment" } + procedure(my_dcos), pointer :: f ! { dg-error "Procedure pointer 'f' at .1. shall not be elemental" } + f => my_dcos ! { dg-error "Nonintrinsic elemental procedure 'my_dcos' is invalid in procedure pointer assignment" } contains real elemental function my_dcos(x) real, intent(in) :: x diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_33.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_33.f90 index 973162bf5e0..30014610a01 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_33.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_33.f90 @@ -22,7 +22,7 @@ end module program start use funcs implicit none - procedure(fun), pointer :: f + procedure(fun), pointer :: f ! { dg-error "Procedure pointer 'f' at .1. shall not be elemental" } real x(3) x = [1,2,3] f => my_dcos ! { dg-error "Mismatch in PURE attribute" } diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90 index a7ea21821d7..4a8020e35b8 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90 @@ -171,7 +171,13 @@ contains end function function l() - procedure(iabs),pointer :: l + ! we cannot use iabs directly as it is elemental + abstract interface + pure function interf_iabs(x) + integer, intent(in) :: x + end function interf_iabs + end interface + procedure(interf_iabs),pointer :: l integer :: i l => iabs if (l(-11)/=11) call abort() diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_result_7.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_result_7.f90 index 1d810c6b5fa..b77e40b7b69 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_result_7.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_result_7.f90 @@ -9,7 +9,14 @@ type :: t end type type(t) :: x -procedure(iabs), pointer :: pp + +! We cannot use "iabs" directly as it is elemental. +abstract interface + pure integer function interf_iabs(x) + integer, intent(in) :: x + end function interf_iabs +end interface +procedure(interf_iabs), pointer :: pp x%p => a @@ -20,7 +27,7 @@ if (pp(-3) /= 3) call abort contains function a() result (b) - procedure(iabs), pointer :: b + procedure(interf_iabs), pointer :: b b => iabs end function diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_result_8.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_result_8.f90 index 17812bc4422..be23f5196cd 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_result_8.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_result_8.f90 @@ -26,7 +26,14 @@ type :: t end type type(t) :: x -procedure(iabs), pointer :: pp +! We cannot use iabs directly as it is elemental +abstract interface + integer pure function interf_iabs(x) + integer, intent(in) :: x + end function interf_iabs +end interface + +procedure(interf_iabs), pointer :: pp procedure(foo), pointer :: pp1 x%p => a ! ok @@ -47,7 +54,7 @@ contains function a (c) result (b) integer, intent(in) :: c - procedure(iabs), pointer :: b + procedure(interf_iabs), pointer :: b if (c .eq. 1) then b => iabs else @@ -55,7 +62,7 @@ contains end if end function - integer function foo (arg) + pure integer function foo (arg) integer, intent (in) :: arg foo = -iabs(arg) end function