Patchwork [Fortran] PRs 59103/58676/41724 - honour pure-/elementalness of intrinsics, add elemental checks

login
register
mail settings
Submitter Tobias Burnus
Date Dec. 8, 2013, 2:31 p.m.
Message ID <52A482BD.9030008@net-b.de>
Download mbox | patch
Permalink /patch/298826/
State New
Headers show

Comments

Tobias Burnus - Dec. 8, 2013, 2:31 p.m.
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
Janus Weil - Dec. 8, 2013, 6 p.m.
Hi Tobias,

first off: I assume the first PR number in the subject line is wrong,
since I don't see how it is related to your patch. I guess you meant
58099?


> 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).

this part is ok with me (since it is exactly what I posted in PR 58099
comment 18 ;)


> b) It rejects dummy procedures / procedure pointers which are ELEMENTAL.

This also looks good (although it should maybe go into resolve_fl_procedure?).


> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?

Ok, thanks for the patch.

Cheers,
Janus

Patch

2013-12-04  Tobias Burnus  <burnus@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  <burnus@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 <jvdelisle@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