re PR fortran/58099 ([F03] over-zealous procedure-pointer error checking)

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.

Co-Authored-By: Janus Weil <janus@gcc.gnu.org>
From-SVN: r205791

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4be8725bd0d82690787fc40716993e9e57654671..1f4e2aa5e4f63236940383e4f6f0e37d071d069a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+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-07  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/59414

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5ed70539a917b618c0a5ceb8d626dbb286594248..ea4632473fc4b546e126b780b48b8f2dfe9c9687 100644 (file)
--- 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 fc320428699bee77b5acbdb19f066aef6c2b880a..b6317053b71c1fb8ff80239d0c6794467ea5f6dd 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,18 @@
+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.
+
 2013-12-07  Janus Weil  <janus@gcc.gnu.org>
 
        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 (file)
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

diff --git a/gcc/testsuite/gfortran.dg/proc_decl_9.f90 b/gcc/testsuite/gfortran.dg/proc_decl_9.f90
index 58ae321899e7f80a2f25227518df289c69767d4a..455c27ce9860a5538551ea09272d9f682b15c3df 100644 (file)
--- 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 bee73f45213bd6483abca11b082d023181ab3c03..61921e78ad01fa55e7bfb6a0bdd988402758d1df 100644 (file)
--- 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 9cae65be0d8ac7c0770792126e75f9304c1cc0ae..9b1ed582bd16544910be42bc375d7527f07e5f35 100644 (file)
--- 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 973162bf5e06dc116650c7eed2b51efa20a03359..30014610a01eb10a8cf9023842970a2002101e26 100644 (file)
--- 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 a7ea21821d71f2ad81dba802e98ecfb9d7231c39..4a8020e35b8726018cace5a236a8d2e0423a84a0 100644 (file)
--- 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 1d810c6b5fad14c170eaded102bb71740be3853f..b77e40b7b692e33b80261e5af3b2854c73e3865b 100644 (file)
--- 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 17812bc4422f4f64b45a685542740619cecb1e7e..be23f5196cd8142adf334893514f898a19c11159 100644 (file)
--- 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