view gcc/testsuite/gfortran.dg/select_type_35.f03 @ 128:fe568345ddd5

fix CbC-example
author mir3636
date Wed, 11 Apr 2018 19:32:28 +0900
parents 04ced10e8804
children 84e7813d76e9
line wrap: on
line source

! { dg-do run }
!
! Contributed by Nathanael Huebbe
! Check fix for PR/70842

program foo

  TYPE, ABSTRACT :: t_Intermediate
  END TYPE t_Intermediate

  type, extends(t_Intermediate) :: t_Foo
    character(:), allocatable :: string
  end type t_Foo

  class(t_Foo), allocatable :: obj

  allocate(obj)
  obj%string = "blabarfoo"

  call bar(obj)

  deallocate(obj)
contains
  subroutine bar(me)
    class(t_Intermediate), target :: me

    class(*), pointer :: alias

    select type(me)
      type is(t_Foo)
      if (len(me%string) /= 9) call abort()
    end select

    alias => me
    select type(alias)
      type is(t_Foo)
        if (len(alias%string) /= 9) call abort()
    end select
  end subroutine bar
end program foo