mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 05:10:33 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/33162 (INTRINSIC functions as ACTUAL argument)

Browse Source 
2007-11-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/33162
	*gfortran.dg/proc_decl_1.f90: Update.
	*gfortran.dg/proc_decl_7.f90: New test.
	*gfortran.dg/proc_decl_8.f90: New test.
	*gfortran.dg/proc_decl_9.f90: New test.
	*gfortran.dg/proc_decl_10.f90: New test.

From-SVN: r130169
This commit is contained in:
Jerry DeLisle 2007-11-14 01:06:13 +00:00
parent 6cc309c923
commit 2daddc8e15
6 changed files with 102 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,12 @@
2007-11-13 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/33162
*gfortran.dg/proc_decl_1.f90: Update.
*gfortran.dg/proc_decl_7.f90: New test.
*gfortran.dg/proc_decl_8.f90: New test.
*gfortran.dg/proc_decl_9.f90: New test.
*gfortran.dg/proc_decl_10.f90: New test.
2007-11-13 Paul Thomas <pault@gcc.gnu.org>
PR fortran/34080

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

@ -37,7 +37,7 @@ program prog
procedure(), allocatable:: b ! { dg-error "PROCEDURE attribute conflicts with ALLOCATABLE attribute" }
procedure(), save:: c ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" }
procedure(dcos) :: my1 ! { dg-error "PROCEDURE statement at .1. not yet implemented" }
procedure(dcos) :: my1
procedure(amax0) :: my2 ! { dg-error "not allowed in PROCEDURE statement" }
procedure(),pointer:: ptr ! { dg-error "not yet implemented" }

32
gcc/testsuite/gfortran.dg/proc_decl_10.f90 Normal file
View File

@ -0,0 +1,32 @@
! { dg-do compile }
! PR33162 INTRINSIC functions as ACTUAL argument
! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
module m
implicit none
interface
double precision function my1(x)
double precision, intent(in) :: x
end function my1
end interface
interface
real(kind=4) function my2(x)
real, intent(in) :: x
end function my2
end interface
interface
real function my3(x, y)
real, intent(in) :: x, y
end function my3
end interface
end module
program test
use m
implicit none
procedure(dcos):: my1 ! { dg-error "Cannot change attributes" }
procedure(cos) :: my2 ! { dg-error "Cannot change attributes" }
procedure(dprod) :: my3 ! { dg-error "Cannot change attributes" }
end program test
! { dg-final { cleanup-modules "m" } }

21
gcc/testsuite/gfortran.dg/proc_decl_7.f90 Normal file
View File

@ -0,0 +1,21 @@
! { dg-do compile }
! PR33162 INTRINSIC functions as ACTUAL argument
! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
module m
implicit none
contains
subroutine sub(a)
interface
function a()
real :: a
end function a
end interface
print *, a()
end subroutine sub
end module m
use m
implicit none
intrinsic cos
call sub(cos) ! { dg-error "Type/rank mismatch in argument" }
end
! { dg-final { cleanup-modules "m" } }

25
gcc/testsuite/gfortran.dg/proc_decl_8.f90 Normal file
View File

@ -0,0 +1,25 @@
! { dg-do compile }
! PR33162 INTRINSIC functions as ACTUAL argument
! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
module m
implicit none
contains
subroutine sub(a)
interface
function a(x)
real :: a, x
intent(in) :: x
end function a
end interface
print *, a(4.0)
end subroutine sub
end module m
use m
implicit none
EXTERNAL foo ! interface is undefined
procedure(cos) :: foo ! { dg-error "Duplicate EXTERNAL attribute specified" }
call sub(foo) ! { dg-error "Type/rank mismatch in argument" }
end
! { dg-final { cleanup-modules "m" } }

14
gcc/testsuite/gfortran.dg/proc_decl_9.f90 Normal file
View File

@ -0,0 +1,14 @@
! { 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)
real ::x
t = x
end function
program p
implicit none
intrinsic sin
procedure(sin):: t
if (t(1.0) /= 1.0) call abort
end program