URL
https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk
Subversion Repositories openrisc_2011-10-31
[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [pointer_check_6.f90] - Rev 302
Compare with Previous | Blame | View Log
! { dg-do run }
! { dg-options "-fcheck=pointer" }
!
! { dg-shouldfail "pointer check" }
! { dg-output ".*At line 104 of file .*Fortran runtime error: Pointer actual argument 'a' is not associated.*" }
!
! PR fortran/40604
!
! The following cases are all valid, but were failing
! for one or the other reason.
!
! Contributed by Janus Weil and Tobias Burnus.
!
subroutine test1()
call test(uec=-1)
contains
subroutine test(str,uec)
implicit none
character*(*), intent(in), optional:: str
integer, intent(in), optional :: uec
end subroutine
end subroutine test1
module m
interface matrixMult
Module procedure matrixMult_C2
End Interface
contains
subroutine test
implicit none
complex, dimension(0:3,0:3) :: m1,m2
print *,Trace(MatrixMult(m1,m2))
end subroutine
complex function trace(a)
implicit none
complex, intent(in), dimension(0:3,0:3) :: a
end function trace
function matrixMult_C2(a,b) result(matrix)
implicit none
complex, dimension(0:3,0:3) :: matrix,a,b
end function matrixMult_C2
end module m
SUBROUTINE plotdop(amat)
IMPLICIT NONE
REAL, INTENT (IN) :: amat(3,3)
integer :: i1
real :: pt(3)
i1 = 1
pt = MATMUL(amat,(/i1,i1,i1/))
END SUBROUTINE plotdop
FUNCTION evaluateFirst(s,n)result(number)
IMPLICIT NONE
CHARACTER(len =*), INTENT(inout) :: s
INTEGER,OPTIONAL :: n
REAL :: number
number = 1.1
end function
SUBROUTINE rw_inp(scpos)
IMPLICIT NONE
REAL scpos
interface
FUNCTION evaluateFirst(s,n)result(number)
IMPLICIT NONE
CHARACTER(len =*), INTENT(inout) :: s
INTEGER,OPTIONAL :: n
REAL :: number
end function
end interface
CHARACTER(len=100) :: line
scpos = evaluatefirst(line)
END SUBROUTINE rw_inp
program test
integer, pointer :: a
! nullify(a)
allocate(a)
a = 1
call sub1a(a)
call sub1b(a)
call sub1c()
contains
subroutine sub1a(a)
integer, pointer :: a
call sub2(a)
call sub3(a)
call sub4(a)
end subroutine sub1a
subroutine sub1b(a)
integer, pointer,optional :: a
call sub2(a)
call sub3(a)
call sub4(a)
end subroutine sub1b
subroutine sub1c(a)
integer, pointer,optional :: a
call sub4(a)
! call sub2(a) ! << Invalid - working correctly, but not allowed in F2003
call sub3(a) ! << INVALID
end subroutine sub1c
subroutine sub4(b)
integer, optional,pointer :: b
end subroutine
subroutine sub2(b)
integer, optional :: b
end subroutine
subroutine sub3(b)
integer :: b
end subroutine
end
! { dg-final { cleanup-modules "m" } }