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