OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Tobias Burnus 2013-12-08 22:34:18 +01:00 committed by Tobias Burnus
parent ae29d0253f
commit 019c0e5dc1
11 changed files with 141 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -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

22
gcc/fortran/resolve.c
View File

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

15
gcc/testsuite/ChangeLog
View File

@ -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

50
gcc/testsuite/gfortran.dg/elemental_subroutine_8.f90 Normal file
View File

@ -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

4
gcc/testsuite/gfortran.dg/proc_decl_9.f90
View File

@ -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

17
gcc/testsuite/gfortran.dg/proc_ptr_11.f90
View File

@ -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

4
gcc/testsuite/gfortran.dg/proc_ptr_32.f90
View File

@ -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

2
gcc/testsuite/gfortran.dg/proc_ptr_33.f90
View File

@ -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" }

8
gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90
View File

@ -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()

11
gcc/testsuite/gfortran.dg/proc_ptr_result_7.f90
View File

@ -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

13
gcc/testsuite/gfortran.dg/proc_ptr_result_8.f90
View File

@ -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