Skip to content

R
riscv-gcc-1
Commit 019c0e5d by Tobias Burnus Committed by Tobias Burnus
Options

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
parent ae29d025
Showing with 141 additions and 17 deletions
gcc/fortran/ChangeLog
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
......
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;
......
gcc/testsuite/ChangeLog
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
......
gcc/testsuite/gfortran.dg/elemental_subroutine_8.f90 0 → 100644
! { 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
gcc/testsuite/gfortran.dg/proc_decl_9.f90
! { 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
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
......
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
......
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" }
......
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()
......
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
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment