gcc/testsuite/gfortran.dg/default_initialization_5.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fdump-tree-original" }
   3 !
   4 ! PR fortran/51435
   5 !
   6 ! Contributed by darmar.xxl@gmail.com
   7 !
   8 module arr_m
   9     type arr_t
  10         real(8), dimension(:), allocatable :: rsk
  11     end type
  12     type arr_t2
  13         integer :: a = 77
  14     end type
  15 end module arr_m
  16 !*********************
  17 module list_m
  18     use arr_m
  19     implicit none
  20
  21     type(arr_t2), target :: tgt
  22
  23     type my_list
  24         type(arr_t), pointer :: head => null()
  25     end type my_list
  26     type my_list2
  27         type(arr_t2), pointer :: head => tgt
  28     end type my_list2
  29 end module list_m
  30 !***********************
  31 module worker_mod
  32     use list_m
  33     implicit none
  34
  35     type data_all_t
  36         type(my_list) :: my_data
  37     end type data_all_t
  38     type data_all_t2
  39         type(my_list2) :: my_data
  40     end type data_all_t2
  41 contains
  42     subroutine do_job()
  43         type(data_all_t) :: dum
  44         type(data_all_t2) :: dum2
  45
  46         if (associated(dum%my_data%head)) then
  47           STOP 1
  48         else
  49             print *, 'OK: do_job my_data%head is NOT associated'
  50         end if
  51
  52         if (dum2%my_data%head%a /= 77) &
  53           STOP 2
  54     end subroutine
  55 end module
  56 !***************
  57 program hello
  58     use worker_mod
  59     implicit none
  60     call do_job()
  61 end program
  62
  63 ! { dg-final { scan-tree-dump-times "my_data.head = 0B" 1 "original" } }
  64 ! { dg-final { scan-tree-dump-times "my_data.head = &tgt" 1 "original" } }