gcc/testsuite/gfortran.dg/derived_pointer_null_1.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-std=gnu" }
   3 !
   4 ! Test of fix (patch unknown) for pr19181 and pr21300. This test is based
   5 ! on the example given in 21300.  Note that this can be executed.
   6 !
   7 ! Contributed by Paul Thomas  <pault@gnu.org>
   8 !
   9   TYPE ast_obs
  10     real, DIMENSION(:), POINTER :: geopos
  11   END TYPE ast_obs
  12
  13   TYPE(ast_obs), PARAMETER    :: undefined_ast_obs = AST_OBS(NULL())
  14   type(ast_obs)               :: my_ast_obs
  15   real, target, dimension(10) :: rt
  16
  17   my_ast_obs%geopos => rt
  18   if (.not.associated (my_ast_obs%geopos)) call abort ()
  19
  20   call get_null_ast_obs (my_ast_obs)
  21   if (associated (my_ast_obs%geopos)) call abort ()
  22
  23 CONTAINS
  24
  25   SUBROUTINE get_null_ast_obs (obs1)
  26     TYPE(ast_obs)  :: obs1
  27     obs1 = undefined_ast_obs
  28     RETURN
  29   END SUBROUTINE get_null_ast_obs
  30
  31 END
  32