85 lines
1.6 KiB
Fortran
85 lines
1.6 KiB
Fortran
! { dg-do run }
|
|
!
|
|
! Test the fix for PR84546 in which the failing cases would
|
|
! have x%vec = ['foo','b '].
|
|
!
|
|
! Contributed by Neil Carlson <neil.n.carlson@gmail.com>
|
|
!
|
|
module any_vector_type
|
|
|
|
type :: any_vector
|
|
class(*), allocatable :: vec(:)
|
|
end type
|
|
|
|
interface any_vector
|
|
procedure any_vector1
|
|
end interface
|
|
|
|
contains
|
|
|
|
function any_vector1(vec) result(this)
|
|
class(*), intent(in) :: vec(:)
|
|
type(any_vector) :: this
|
|
allocate(this%vec, source=vec)
|
|
end function
|
|
|
|
end module
|
|
|
|
program main
|
|
|
|
use any_vector_type
|
|
implicit none
|
|
|
|
class(*), allocatable :: x
|
|
character(*), parameter :: vec(2) = ['foo','bar']
|
|
integer :: vec1(3) = [7,8,9]
|
|
|
|
call foo1
|
|
call foo2
|
|
call foo3
|
|
call foo4
|
|
|
|
contains
|
|
|
|
subroutine foo1 ! This always worked
|
|
allocate (any_vector :: x)
|
|
select type (x)
|
|
type is (any_vector)
|
|
x = any_vector(vec)
|
|
end select
|
|
call bar(1)
|
|
deallocate (x)
|
|
end
|
|
|
|
subroutine foo2 ! Failure found during diagnosis
|
|
x = any_vector (vec)
|
|
call bar(2)
|
|
deallocate (x)
|
|
end
|
|
|
|
subroutine foo3 ! Original failure
|
|
allocate (x, source = any_vector (vec))
|
|
call bar(3)
|
|
deallocate (x)
|
|
end
|
|
|
|
subroutine foo4 ! This always worked
|
|
allocate (x, source = any_vector (vec1))
|
|
call bar(4)
|
|
deallocate (x)
|
|
end
|
|
|
|
subroutine bar (stop_flag)
|
|
integer :: stop_flag
|
|
select type (x)
|
|
type is (any_vector)
|
|
select type (xvec => x%vec)
|
|
type is (character(*))
|
|
if (any(xvec /= vec)) stop stop_flag
|
|
type is (integer)
|
|
if (any(xvec /= (vec1))) stop stop_flag
|
|
end select
|
|
end select
|
|
end
|
|
end program
|