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
23CONTAINS
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
31END
32
33