gcc/testsuite/gfortran.dg/pointer_function_actual_1.f90

   1 ! { dg-do run }
   2 ! { dg-options "-std=legacy" }
   3 !
   4 ! Tests the fix for PR31209, in which an ICE would result because
   5 ! the reference to the pointer function f would be indirected, as
   6 ! if it were the result that is being passed.
   7 !
   8 ! COntributed by Joost VandeVondele <jv244@cam.ac.uk>
   9 !
  10 FUNCTION F() RESULT(RES)
  11  INTEGER, POINTER :: RES
  12  ALLOCATE(RES)
  13  RES=2
  14 END FUNCTION F
  15
  16 SUBROUTINE S1(f,*,*)
  17  INTERFACE
  18   FUNCTION F() RESULT(RES)
  19    INTEGER, POINTER :: RES
  20   END FUNCTION F
  21  END INTERFACE
  22  RETURN F()
  23 END SUBROUTINE
  24
  25 PROGRAM TEST
  26    INTERFACE
  27     FUNCTION F() RESULT(RES)
  28      INTEGER, POINTER :: RES
  29     END FUNCTION F
  30    END INTERFACE
  31
  32
  33    INTERFACE
  34     SUBROUTINE S1(f,*,*)
  35       INTERFACE
  36        FUNCTION F() RESULT(RES)
  37         INTEGER, POINTER :: RES
  38        END FUNCTION F
  39       END INTERFACE
  40      END SUBROUTINE
  41    END INTERFACE
  42
  43    CALL S1(F,*1,*2)
  44
  45    1 CONTINUE
  46    CALL ABORT()
  47
  48    GOTO 3
  49    2 CONTINUE
  50
  51    3 CONTINUE
  52 END
  53