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

Subversion Repositories openrisc

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

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
! a pointer 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, TARGET  :: c
  INTEGER, POINTER :: b
 
  aa(1)=10.
  aa(2)=11.
 
  b=>c
  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
 
 
  b => NULL()
  ! 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), POINTER :: 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), POINTER :: 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			`! a pointer 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, TARGET :: c`
13			`INTEGER, POINTER :: b`
14
15			`aa(1)=10.`
16			`aa(2)=11.`
17
18			`b=>c`
19			`b=1`
20
21			`! WRITE(,) 'Both f1 and ff work if the optional parameter is present:'`
22
23			`rr=f1(aa,b)`
24			`! WRITE(,) ' rr(1)=', rr(1), ' rr(2)=', rr(2)`
25			`IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT`
26
27			`rr=0`
28			`rr=ff(aa,b)`
29			`! WRITE(,) ' rr(1)=', rr(1), ' rr(2)=', rr(2)`
30			`IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT`
31
32
33			`b => NULL()`
34			`! WRITE(,) 'But only f1 works if the optional parameter is absent:'`
35
36			`rr=0`
37			`rr=f1(aa, b)`
38			`! WRITE(,) ' rr(1)=', rr(1), ' rr(2)=', rr(2)`
39			`IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT`
40
41			`rr = 0`
42			`rr=ff(aa, b)`
43			`! WRITE(,) ' rr(1)=', rr(1), ' rr(2)=', rr(2)`
44			`IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT`
45
46
47			`CONTAINS`
48
49			`FUNCTION ff(a,b)`
50			`IMPLICIT NONE`
51			`REAL(KIND=8), INTENT(IN) :: a(:)`
52			`REAL(KIND=8), DIMENSION(SIZE(a)) :: ff`
53			`INTEGER, INTENT(IN), POINTER :: b`
54			`REAL(KIND=8), DIMENSION(2, SIZE(a)) :: ac`
55			`ac(1,:)=a`
56			`ac(2,:)=a**2`
57			`ff=SUM(gg(ac,b), dim=1)`
58			`END FUNCTION ff`
59
60			`FUNCTION f1(a,b)`
61			`IMPLICIT NONE`
62			`REAL(KIND=8), INTENT(IN) :: a(:)`
63			`REAL(KIND=8), DIMENSION(SIZE(a)) :: f1`
64			`INTEGER, INTENT(IN), POINTER :: b`
65			`REAL(KIND=8), DIMENSION(2, SIZE(a)) :: ac`
66			`ac(1,:)=a`
67			`ac(2,:)=a**2`
68			`f1=gg(ac(1,:),b)+gg(ac(2,:),b) ! This is the same as in ff, but without using the elemental feature of gg`
69			`END FUNCTION f1`
70
71			`ELEMENTAL REAL(KIND=8) FUNCTION gg(a,b)`
72			`IMPLICIT NONE`
73			`REAL(KIND=8), INTENT(IN) :: a`
74			`INTEGER, INTENT(IN), OPTIONAL :: b`
75			`INTEGER ::b1`
76			`IF(PRESENT(b)) THEN`
77			`b1=b`
78			`ELSE`
79			`b1=1`
80			`ENDIF`
81			`gg=a**b1`
82			`END FUNCTION gg`
83
84
85			`END PROGRAM test`

Browse

Tools

Subversion Repositories openrisc

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