This patch is about rejects-valid and accepts-invalid and does
essentially only:
a) It ensures that sym->attr.pure/elemental gets set for pure/elemental
intrinsics (isym->pure/elemental).
b) It rejects dummy procedures / procedure pointers which are ELEMENTAL.
* * *
To quote (link see PR) from interpretation request F03-0130:
Q: "When one of these procedures [i.e. the specific intrinsic procedures
listed in 13.6 and not marked with a bullet] is associated with a dummy
procedure or procedure pointer, does it still have the elemental property?"
A: "The specific intrinsic procedure itself retains the elemental
property (so a reference using its own name can be elemental), but the
dummy procedure or procedure pointer associated with it is not elemental
and so cannot be used to reference the specific intrinsic procedure
elementally."
And the Fortran standard:
C1218 (R1211) If a proc-interface describes an elemental procedure, each
procedure-entity-name shall specify an external procedure.
"12.5.2.9 Actual arguments associated with dummy procedure entities [...]
If the interface of a dummy procedure is explicit, its characteristics
as a procedure (12.3.1) shall be the same as those of its effective
argument, except that a pure effective argument may be associated with a
dummy argument that is not pure and an elemental intrinsic actual
procedure may be associated with a dummy procedure (which cannot be
elemental)."
* * *
I think the current patch handles it correctly. Last think I was
pondering on is whether "procedure(sin) :: bar" makes "bar" elemental or
not. I think it does, which makes it impossible to use, e.g.
"procedure(sin), pointer :: pp => sin". However, creating an (abstract)
interface which matches "sin" except for the elemental attribute, is
possible and permits: "procedure(sin_interf), pointer :: pp => sin".
I hope that I got everything right in the patch.
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
2013-12-04 Tobias Burnus <bur...@net-b.de>
PR fortran/59103
PR fortran/58676
PR fortran/41724
* resolve.c (gfc_resolve_intrinsic): Set elemental/pure.
(resolve_symbol): Reject pure dummy procedures/procedure
pointers.
(gfc_explicit_interface_required): Don't require a
match of ELEMENTAL for intrinsics.
2013-12-04 Tobias Burnus <bur...@net-b.de>
PR fortran/59103
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.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5ed7053..58c4d61 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;
@@ -12757,6 +12760,23 @@ resolve_symbol (gfc_symbol *sym)
&& !resolve_procedure_interface (sym))
return;
+ /* F2008, C1218. */
+ if (sym->attr.flavor == FL_PROCEDURE && 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;
+ }
+ if (sym->attr.dummy)
+ {
+ gfc_error ("Dummy procedure '%s' at %L shall not be elemental",
+ sym->name, &sym->declared_at);
+ return;
+ }
+ }
+
if (sym->attr.is_protected && !sym->attr.proc_pointer
&& (sym->attr.procedure || sym->attr.external))
{
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_9.f90 b/gcc/testsuite/gfortran.dg/proc_decl_9.f90
index 58ae321..455c27c 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 <jvdeli...@gcc.gnu.org>
-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 bee73f4..dd3e09d 100644
--- a/gcc/testsuite/gfortran.dg/proc_ptr_11.f90
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_11.f90
@@ -48,13 +48,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 9cae65b..9b1ed58 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 973162b..3001461 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 a7ea218..4a8020e 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 1d810c6..b77e40b 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 17812bc..be23f51 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
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 0000000..c557d3a
--- /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
