OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [proc_ptr_comp_12.f90] - Blame information for rev 774

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
!
3
! PR 40646: [F03] array-valued procedure pointer components
4
!
5
! Original test case by Charlie Sharpsteen 
6
! Modified by Janus Weil 
7
 
8
module bugTestMod
9
  implicit none
10
  type:: boundTest
11
    procedure(returnMat), pointer, nopass:: test
12
  end type boundTest
13
contains
14
  function returnMat( a, b ) result( mat )
15
    integer:: a, b
16
    double precision, dimension(a,b):: mat
17
    mat = 1d0
18
  end function returnMat
19
end module bugTestMod
20
 
21
program bugTest
22
  use bugTestMod
23
  implicit none
24
  type( boundTest ):: testObj
25
  double precision, dimension(2,2):: testCatch
26
  testObj%test => returnMat
27
  testCatch = testObj%test(2,2)
28
  print *,testCatch
29
  if (sum(testCatch)/=4) call abort()
30
  print *,testObj%test(3,3)
31
  if (sum(testObj%test(3,3))/=9) call abort()
32
end program bugTest
33
 
34
! { dg-final { cleanup-modules "bugtestmod" } }
35
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.