Subversion Repositories openrisc

! { dg-do run }

!

! PR fortran/50981

! The program used to dereference a NULL pointer when trying to access

! an optional 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

  aa(1)=10.

  aa(2)=11.

  ! WRITE(*,*) 'Both f1 and ff work if the optional parameter is present:'

  rr=f1(aa,1)

  ! WRITE(*,*) ' rr(1)=', rr(1), '  rr(2)=', rr(2)

  IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT

  rr=0

  rr=ff(aa,1)

  ! WRITE(*,*) ' rr(1)=', rr(1), '  rr(2)=', rr(2)

  IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT

  ! WRITE(*,*) 'But only f1 works if the optional parameter is absent:'

  rr=0

  rr=f1(aa)

  ! WRITE(*,*) ' rr(1)=', rr(1), '  rr(2)=', rr(2)

  IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT

  rr = 0

  rr=ff(aa)

  ! WRITE(*,*) ' rr(1)=', rr(1), '  rr(2)=', rr(2)

  IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT

CONTAINS

    ELEMENTAL REAL(KIND=8) FUNCTION ff(a,b)

      IMPLICIT NONE

      REAL(KIND=8), INTENT(IN) :: a

      INTEGER, INTENT(IN), OPTIONAL :: b

      REAL(KIND=8), DIMENSION(2) :: ac

      ac(1)=a

      ac(2)=a**2

      ff=SUM(gg(ac,b))

    END FUNCTION ff

    ELEMENTAL REAL(KIND=8) FUNCTION f1(a,b)

      IMPLICIT NONE

      REAL(KIND=8), INTENT(IN) :: a

      INTEGER, INTENT(IN), OPTIONAL :: b

      REAL(KIND=8), DIMENSION(2) :: 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