Subversion Repositories openrisc

! { dg-do compile }

! { dg-do compile }

!

!

! PR 43169: [OOP] gfortran rejects PURE procedure with SELECT TYPE construct

! PR 43169: [OOP] gfortran rejects PURE procedure with SELECT TYPE construct

!

!

! Original test case by Todd Hay 

! Original test case by Todd Hay 

! Modified by Janus Weil 

! Modified by Janus Weil 

  implicit none

  implicit none

  real :: g

  real :: g

contains

contains

  pure subroutine sub1(x)

  pure subroutine sub1(x)

    type :: myType

    type :: myType

      real :: a

      real :: a

    end type myType

    end type myType

    class(myType), intent(inout) :: x

    class(myType), intent(inout) :: x

    real :: r3

    real :: r3

    select type(x)

    select type(x)

    class is (myType)

    class is (myType)

      x%a = 42.

      x%a = 42.

      r3 =  43.

      r3 =  43.

      g = 44.             ! { dg-error "Cannot assign to variable" }

      g = 44.             ! { dg-error "Cannot assign to variable" }

    end select

    end select

  end subroutine

  end subroutine

  pure subroutine sub2

  pure subroutine sub2

    real :: r1

    real :: r1

    block

    block

      real :: r2

      real :: r2

      r1 = 45.

      r1 = 45.

      r2 = 46.

      r2 = 46.

      g = 47.             ! { dg-error "Cannot assign to variable" }

      g = 47.             ! { dg-error "Cannot assign to variable" }

    end block

    end block

  end subroutine

  end subroutine

  pure subroutine sub3

  pure subroutine sub3

    block

    block

      integer, save :: i  ! { dg-error "cannot be specified in a PURE procedure" }

      integer, save :: i  ! { dg-error "cannot be specified in a PURE procedure" }

      integer :: j = 5    ! { dg-error "is not allowed in a PURE procedure" }

      integer :: j = 5    ! { dg-error "is not allowed in a PURE procedure" }

    end block

    end block

  end subroutine

  end subroutine

end

end