gcc/testsuite/gfortran.dg/c_ptr_tests_14.f90

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