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

2007-10-31  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/33162
	* gfortran.dg/interface_19.f90: New.
	* gfortran.dg/interface_20.f90: New.
	* gfortran.dg/interface_21.f90: New.

From-SVN: r129799
This commit is contained in:
Jerry DeLisle 2007-10-31 14:30:48 +00:00
parent 26033479fb
commit 69d10e15fb
4 changed files with 78 additions and 0 deletions

View File

@ -1,3 +1,10 @@
2007-10-31 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/33162
* gfortran.dg/interface_19.f90: New.
* gfortran.dg/interface_20.f90: New.
* gfortran.dg/interface_21.f90: New.
2007-10-31 Sebastian Pop <sebastian.pop@amd.com>
PR tree-optimization/32377

View File

@ -0,0 +1,29 @@
! { dg-do run }
! 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)
optional :: a
character(25) :: temp
interface
function a(x)
real(kind=8):: a
real(kind=8):: x
intent(in) :: x
end function a
end interface
if(present(a)) then
write(temp,'(f16.10)')a(4.0d0)
if (trim(temp) /= ' -0.6536436209') call abort
endif
end subroutine sub
end module m
use m
implicit none
intrinsic dcos
call sub()
call sub(dcos)
end

View File

@ -0,0 +1,20 @@
! { 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

View File

@ -0,0 +1,22 @@
! { 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 ! implicit interface is undefined
call sub(foo) ! { dg-error "Type/rank mismatch in argument" }
end