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

[Tobias Burnus <burnus at net-b dot de>]

Hi Janus,

Janus Weil wrote:
> 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?

Yes. Well spotted.

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

I have now added your name to the ChangeLog.

> > b) It rejects dummy procedures / procedure pointers which are ELEMENTAL.
> This also looks good (although it should maybe go into resolve_fl_procedure?).

I had it elsewhere (I forgot where) and there I'd the problem that I got 
multiple times the same error. But at least with the current patch and 
looking manually at the output for elemental_subroutine_8.f90 it seems 
to work. Thanks for the suggestion.

Tobias

PS: I have now committed the attached patch as Rev. 205791.

2013-12-08  Tobias Burnus  <burnus@net-b.de>
	    Janus Weil  <janus@gcc.gnu.org>

	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  <burnus@net-b.de>

	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.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5ed7053..ea46324 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/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..61921e7 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 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