1! { dg-do run }
2!
3! associated_target_7.f90: Test the fix for PR98565.
4!
5! Contributed by Yves Secretan  <yves.secretan@ete.inrs.ca>
6!
7MODULE PS_SN0N_M
8
9   IMPLICIT NONE
10   PRIVATE
11
12   TYPE, PUBLIC :: DT_GRID_T
13       INTEGER :: NNT
14   CONTAINS
15       ! PASS
16   END TYPE DT_GRID_T
17
18   TYPE, PUBLIC :: LM_ELEM_T
19       CLASS(DT_GRID_T), POINTER :: PGRID
20   CONTAINS
21       PROCEDURE, PUBLIC :: REQPGRID => LM_ELEM_REGPGRID
22   END TYPE LM_ELEM_T
23
24   TYPE, PUBLIC :: PS_SN0N_T
25      CLASS(DT_GRID_T), POINTER :: PGRID
26
27   CONTAINS
28      PROCEDURE, PUBLIC :: ASGOELE  => PS_SN0N_ASGOELE
29   END TYPE PS_SN0N_T
30
31
32CONTAINS
33   !------------------------------------------------------------------------
34   !------------------------------------------------------------------------
35   FUNCTION LM_ELEM_REGPGRID(SELF) RESULT(PGRID)
36   CLASS(DT_GRID_T), POINTER :: PGRID
37   CLASS(LM_ELEM_T), INTENT(IN) :: SELF
38   PGRID => SELF%PGRID
39   RETURN
40   END FUNCTION LM_ELEM_REGPGRID
41
42   !------------------------------------------------------------------------
43   !------------------------------------------------------------------------
44   FUNCTION PS_SN0N_ASGOELE(SELF, OELE) RESULT(ERMSG)
45
46   INTEGER :: ERMSG
47   CLASS(PS_SN0N_T), INTENT(IN) :: SELF
48   CLASS(LM_ELEM_T), INTENT(IN) :: OELE
49
50   !CLASS(DT_GRID_T), POINTER :: PGRID
51   LOGICAL :: ISOK
52   !------------------------------------------------------------------------
53
54   ! ASSOCIATED with temp variable compiles
55   !PGRID => OELE%REQPGRID()
56   !ISOK = ASSOCIATED(SELF%PGRID, PGRID)
57
58   ! ASSOCIATE without temp variable crashes with ICE
59   ISOK = ASSOCIATED(SELF%PGRID, OELE%REQPGRID())
60   ERMSG = 0
61   IF (ISOK) ERMSG = 1
62
63   RETURN
64   END FUNCTION PS_SN0N_ASGOELE
65
66END MODULE PS_SN0N_M
67
68
69   USE PS_SN0N_M
70   CLASS(PS_SN0N_T), ALLOCATABLE :: SELF
71   CLASS(LM_ELEM_T), ALLOCATABLE :: OELE
72   TYPE (DT_GRID_T), TARGET :: GRID1 = DT_GRID_T (42)
73   TYPE (DT_GRID_T), TARGET :: GRID2 = DT_GRID_T (84)
74
75   ALLOCATE (PS_SN0N_T :: SELF)
76   ALLOCATE (LM_ELEM_T :: OELE)
77   SELF%PGRID => GRID1
78
79   OELE%PGRID => NULL ()
80   IF (SELF%ASGOELE (OELE) .NE. 0) STOP 1
81
82   OELE%PGRID => GRID2
83   IF (SELF%ASGOELE (OELE) .NE. 0) STOP 2
84
85   OELE%PGRID => GRID1
86   IF (SELF%ASGOELE (OELE) .NE. 1) STOP 3
87END
88