gcc/testsuite/gfortran.dg/interface_26.f90

   1 ! { dg-do compile }
   2 ! Tests the fix for PR39295, in which the check of the interfaces
   3 ! at lines 26 and 43 failed because opfunc1 is identified as a
   4 ! function by usage, whereas opfunc2 is not. This testcase checks
   5 ! that TKR is stll OK in these cases.
   6 !
   7 ! Contributed by Jon Hurst <jhurst@ucar.edu>
   8 !
   9 MODULE  funcs
  10 CONTAINS
  11   INTEGER FUNCTION test1(a,b,opfunc1)
  12     INTEGER :: a,b
  13     INTEGER, EXTERNAL :: opfunc1
  14     test1 = opfunc1( a, b )
  15   END FUNCTION test1
  16   INTEGER FUNCTION sumInts(a,b)
  17     INTEGER :: a,b
  18     sumInts = a + b
  19   END FUNCTION sumInts
  20 END MODULE funcs
  21
  22 PROGRAM test
  23   USE funcs
  24   INTEGER :: rs
  25   INTEGER, PARAMETER :: a = 2, b = 1
  26   rs = recSum( a, b, test1, sumInts ) ! { dg-error "Type/rank mismatch in argument" }
  27   write(*,*) "Results", rs
  28 CONTAINS
  29   RECURSIVE INTEGER FUNCTION recSum( a,b,UserFunction,UserOp ) RESULT( res )
  30     IMPLICIT NONE
  31     INTEGER :: a,b
  32     INTERFACE
  33        INTEGER FUNCTION UserFunction(a,b,opfunc2)
  34          INTEGER :: a,b
  35          REAL, EXTERNAL :: opfunc2
  36        END FUNCTION UserFunction
  37     END INTERFACE
  38     INTEGER, EXTERNAL :: UserOp
  39
  40     res = UserFunction( a,b, UserOp ) ! { dg-error "Type/kind mismatch in return value" }
  41
  42     if( res .lt. 10 ) then
  43        res = recSum( a, res, UserFunction, UserOp )
  44     end if
  45   END FUNCTION recSum
  46 END PROGRAM test