gcc/testsuite/gfortran.dg/namelist_85.f90

   1 ! { dg-do run  }
   2 ! { dg-options -std=gnu }
   3 ! PR55117  Programs fails namelist read (contains derived types objects)
   4 program test_type_extension
   5
   6   type tk_t
   7      real :: x
   8   end type tk_t
   9
  10   type, extends(tk_t) :: tke_t
  11      character(8) :: string
  12   end type tke_t
  13
  14   type, extends(tke_t) :: deep
  15     integer :: int1
  16     real :: y
  17     character(10) :: the_name
  18   end type deep
  19
  20   type other
  21     integer :: one_oh
  22     integer :: two_oh
  23   end type other
  24
  25   type plain_type
  26     integer :: var1
  27     type(other) :: var2
  28     real :: var3
  29   end type plain_type
  30
  31   type some_other
  32     complex :: varx
  33     type(tke_t) :: tke
  34     type (plain_type) :: varpy
  35     real  :: vary
  36   end type some_other
  37
  38   type(deep) :: trouble
  39   type(some_other) :: somethinelse
  40   type(tke_t) :: tke
  41   integer :: answer
  42
  43   namelist /test_NML/ trouble, somethinelse, tke, answer
  44
  45   tke%x = 0.0
  46   tke%string = "xxxxxxxx"
  47   answer = 5
  48   trouble%x = 5.34
  49   trouble%y = 4.25
  50   trouble%string = "yyyy"
  51   trouble%the_name = "mischief"
  52
  53   open(10, status="scratch")
  54
  55   write(10,*) "&TEST_NML"
  56   write(10,*) "TKE%X=  3.14    ,"
  57   write(10,*) "TKE%STRING='kf7rcc',"
  58   write(10,*) "ANSWER=          42,"
  59   write(10,*) "/"
  60   rewind(10)
  61
  62   read(10,NML=test_NML)
  63   if (tke%x - 3.14000010 > .00001) call abort
  64   if (tke%string /= "kf7rcc") call abort
  65   if (answer /= 42) call abort ! hitchkikers guide to the galaxy
  66 end program test_type_extension