gcc/testsuite/gfortran.dg/c_ptr_tests_15.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fwhole-file -fdump-tree-original" }
   3 !
   4 ! PR fortran/43042 - fix ICE with c_null_ptr when using
   5 ! -fwhole-file (or -flto, which implies -fwhole-file).
   6 !
   7 ! Testcase based on c_ptr_tests_14.f90  (PR fortran/41298)
   8 ! Check that c_null_ptr default initializer is really applied
   9
  10 module m
  11   use iso_c_binding
  12   type, public :: fgsl_file
  13      type(c_ptr)    :: gsl_file = c_null_ptr
  14      type(c_funptr) :: gsl_func = c_null_funptr
  15      type(c_ptr)    :: NIptr
  16      type(c_funptr) :: NIfunptr
  17   end type fgsl_file
  18 contains
  19   subroutine sub(aaa,bbb)
  20     type(fgsl_file), intent(out)   :: aaa
  21     type(fgsl_file), intent(inout) :: bbb
  22   end subroutine
  23   subroutine proc() bind(C)
  24   end subroutine proc
  25 end module m
  26
  27 program test
  28   use m
  29   implicit none
  30   type(fgsl_file) :: file, noreinit
  31   integer, target :: tgt
  32
  33   call sub(file, noreinit)
  34   if(c_associated(file%gsl_file)) call abort()
  35   if(c_associated(file%gsl_func)) call abort()
  36
  37   file%gsl_file = c_loc(tgt)
  38   file%gsl_func = c_funloc(proc)
  39   call sub(file, noreinit)
  40   if(c_associated(file%gsl_file)) call abort()
  41   if(c_associated(file%gsl_func)) call abort()
  42 end program test
  43
  44 ! { dg-final { scan-tree-dump-times "c_funptr.\[0-9\]+ = 0B;" 1 "original" } }
  45 ! { dg-final { scan-tree-dump-times "fgsl_file.\[0-9\]+.gsl_func = c_funptr.\[0-9\]+;" 1 "original" } }
  46 ! { dg-final { scan-tree-dump-times "c_ptr.\[0-9\]+ = 0B;" 1 "original" } }
  47 ! { dg-final { scan-tree-dump-times "fgsl_file.\[0-9\]+.gsl_file = c_ptr.\[0-9\]+;" 1 "original" } }
  48
  49 ! { dg-final { scan-tree-dump-times "NIptr = 0B"    0 "original" } }
  50 ! { dg-final { scan-tree-dump-times "NIfunptr = 0B" 0 "original" } }
  51
  52 ! { dg-final { scan-tree-dump-times "bbb =" 0 "original" } }
  53
  54 ! { dg-final { cleanup-tree-dump "original" } }