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

Subversion Repositories openrisc

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

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


! { dg-do run }
!
! PR fortran/50981
! The program used to dereference a NULL pointer when trying to access
! an allocatable dummy argument to be passed to an elemental subprocedure.
!
! Original testcase from Andriy Kostyuk 
 
PROGRAM test
  IMPLICIT NONE
  REAL(KIND=8), DIMENSION(2) :: aa, rr
  INTEGER, ALLOCATABLE :: b
 
  aa(1)=10.
  aa(2)=11.
 
  ALLOCATE(b)
  b=1
 
  ! WRITE(*,*) 'Both f1 and ff work if the optional parameter is present:'
 
  rr=f1(aa,b)
  ! WRITE(*,*) ' rr(1)=', rr(1), '  rr(2)=', rr(2)
  IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT
 
  rr=0
  rr=ff(aa,b)
  ! WRITE(*,*) ' rr(1)=', rr(1), '  rr(2)=', rr(2)
  IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT
 
 
  DEALLOCATE(b)
  ! WRITE(*,*) 'But only f1 works if the optional parameter is absent:'
 
  rr=0
  rr=f1(aa, b)
  ! WRITE(*,*) ' rr(1)=', rr(1), '  rr(2)=', rr(2)
  IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT
 
  rr = 0
  rr=ff(aa, b)
  ! WRITE(*,*) ' rr(1)=', rr(1), '  rr(2)=', rr(2)
  IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT
 
 
CONTAINS
 
    FUNCTION ff(a,b)
      IMPLICIT NONE
      REAL(KIND=8), INTENT(IN) :: a(:)
      REAL(KIND=8), DIMENSION(SIZE(a)) :: ff
      INTEGER, INTENT(IN), ALLOCATABLE :: b
      REAL(KIND=8), DIMENSION(2, SIZE(a)) :: ac
      ac(1,:)=a
      ac(2,:)=a**2
      ff=SUM(gg(ac,b), dim=1)
    END FUNCTION ff
 
    FUNCTION f1(a,b)
      IMPLICIT NONE
      REAL(KIND=8), INTENT(IN) :: a(:)
      REAL(KIND=8), DIMENSION(SIZE(a)) :: f1
      INTEGER, INTENT(IN), ALLOCATABLE :: b
      REAL(KIND=8), DIMENSION(2, SIZE(a)) :: ac
      ac(1,:)=a
      ac(2,:)=a**2
      f1=gg(ac(1,:),b)+gg(ac(2,:),b) ! This is the same as in ff, but without using the elemental feature of gg
    END FUNCTION f1
 
    ELEMENTAL REAL(KIND=8) FUNCTION gg(a,b)
      IMPLICIT NONE
      REAL(KIND=8), INTENT(IN) :: a
      INTEGER, INTENT(IN), OPTIONAL :: b
      INTEGER ::b1
      IF(PRESENT(b)) THEN
        b1=b
      ELSE
        b1=1
      ENDIF
      gg=a**b1
    END FUNCTION gg
 
 
END PROGRAM test

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { dg-do run }`
2			`!`
3			`! PR fortran/50981`
4			`! The program used to dereference a NULL pointer when trying to access`
5			`! an allocatable dummy argument to be passed to an elemental subprocedure.`
6			`!`
7			`! Original testcase from Andriy Kostyuk`
8
9			`PROGRAM test`
10			`IMPLICIT NONE`
11			`REAL(KIND=8), DIMENSION(2) :: aa, rr`
12			`INTEGER, ALLOCATABLE :: b`
13
14			`aa(1)=10.`
15			`aa(2)=11.`
16
17			`ALLOCATE(b)`
18			`b=1`
19
20			`! WRITE(,) 'Both f1 and ff work if the optional parameter is present:'`
21
22			`rr=f1(aa,b)`
23			`! WRITE(,) ' rr(1)=', rr(1), ' rr(2)=', rr(2)`
24			`IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT`
25
26			`rr=0`
27			`rr=ff(aa,b)`
28			`! WRITE(,) ' rr(1)=', rr(1), ' rr(2)=', rr(2)`
29			`IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT`
30
31
32			`DEALLOCATE(b)`
33			`! WRITE(,) 'But only f1 works if the optional parameter is absent:'`
34
35			`rr=0`
36			`rr=f1(aa, b)`
37			`! WRITE(,) ' rr(1)=', rr(1), ' rr(2)=', rr(2)`
38			`IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT`
39
40			`rr = 0`
41			`rr=ff(aa, b)`
42			`! WRITE(,) ' rr(1)=', rr(1), ' rr(2)=', rr(2)`
43			`IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT`
44
45
46			`CONTAINS`
47
48			`FUNCTION ff(a,b)`
49			`IMPLICIT NONE`
50			`REAL(KIND=8), INTENT(IN) :: a(:)`
51			`REAL(KIND=8), DIMENSION(SIZE(a)) :: ff`
52			`INTEGER, INTENT(IN), ALLOCATABLE :: b`
53			`REAL(KIND=8), DIMENSION(2, SIZE(a)) :: ac`
54			`ac(1,:)=a`
55			`ac(2,:)=a**2`
56			`ff=SUM(gg(ac,b), dim=1)`
57			`END FUNCTION ff`
58
59			`FUNCTION f1(a,b)`
60			`IMPLICIT NONE`
61			`REAL(KIND=8), INTENT(IN) :: a(:)`
62			`REAL(KIND=8), DIMENSION(SIZE(a)) :: f1`
63			`INTEGER, INTENT(IN), ALLOCATABLE :: b`
64			`REAL(KIND=8), DIMENSION(2, SIZE(a)) :: ac`
65			`ac(1,:)=a`
66			`ac(2,:)=a**2`
67			`f1=gg(ac(1,:),b)+gg(ac(2,:),b) ! This is the same as in ff, but without using the elemental feature of gg`
68			`END FUNCTION f1`
69
70			`ELEMENTAL REAL(KIND=8) FUNCTION gg(a,b)`
71			`IMPLICIT NONE`
72			`REAL(KIND=8), INTENT(IN) :: a`
73			`INTEGER, INTENT(IN), OPTIONAL :: b`
74			`INTEGER ::b1`
75			`IF(PRESENT(b)) THEN`
76			`b1=b`
77			`ELSE`
78			`b1=1`
79			`ENDIF`
80			`gg=a**b1`
81			`END FUNCTION gg`
82
83
84			`END PROGRAM test`

Browse

Tools

Subversion Repositories openrisc

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