gcc/testsuite/gfortran.dg/pointer_function_actual_1.f90

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