gcc/testsuite/gfortran.dg/unlimited_polymorphic_26.f90

   1 ! { dg-do run }
   2 !
   3 ! Test contributed by Valery Weber  <valeryweber@hotmail.com>
   4
   5 module mod
   6
   7   TYPE, PUBLIC :: dict_entry_type
   8      CLASS( * ), ALLOCATABLE :: key
   9      CLASS( * ), ALLOCATABLE :: val
  10   END TYPE dict_entry_type
  11
  12
  13 contains
  14
  15   SUBROUTINE dict_put ( this, key, val )
  16     CLASS(dict_entry_type), INTENT(INOUT)     :: this
  17     CLASS(*), INTENT(IN)                     :: key, val
  18     INTEGER                                  :: istat
  19     ALLOCATE( this%key, SOURCE=key, STAT=istat )
  20     ALLOCATE( this%val, SOURCE=val, STAT=istat )
  21   end SUBROUTINE dict_put
  22 end module mod
  23
  24 program test
  25   use mod
  26   type(dict_entry_type) :: t
  27   call dict_put(t, "foo", 42)
  28
  29   if (.NOT. allocated(t%key)) call abort()
  30   select type (x => t%key)
  31     type is (CHARACTER(*))
  32       if (x /= "foo") call abort()
  33     class default
  34       call abort()
  35   end select
  36   deallocate(t%key)
  37
  38   if (.NOT. allocated(t%val)) call abort()
  39   select type (x => t%val)
  40     type is (INTEGER)
  41       if (x /= 42) call abort()
  42     class default
  43       call abort()
  44   end select
  45   deallocate(t%val)
  46 end
  47