+2009-02-26 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/39295
+ * interface.c (compare_type_rank_if): Return 1 if the symbols
+ are the same and deal with external procedures where one is
+ identified to be a function or subroutine by usage but the
+ other is not.
+
2009-02-26 Paul Thomas <pault@gcc.gnu.org>
PR fortran/39292
if (s1 == NULL || s2 == NULL)
return s1 == s2 ? 1 : 0;
+ if (s1 == s2)
+ return 1;
+
if (s1->attr.flavor != FL_PROCEDURE && s2->attr.flavor != FL_PROCEDURE)
return compare_type_rank (s1, s2);
if (s1->attr.flavor != FL_PROCEDURE || s2->attr.flavor != FL_PROCEDURE)
return 0;
- /* At this point, both symbols are procedures. */
- if ((s1->attr.function == 0 && s1->attr.subroutine == 0)
- || (s2->attr.function == 0 && s2->attr.subroutine == 0))
- return 0;
+ /* At this point, both symbols are procedures. It can happen that
+ external procedures are compared, where one is identified by usage
+ to be a function or subroutine but the other is not. Check TKR
+ nonetheless for these cases. */
+ if (s1->attr.function == 0 && s1->attr.subroutine == 0)
+ return s1->attr.external == 1 ? compare_type_rank (s1, s2) : 0;
+
+ if (s2->attr.function == 0 && s2->attr.subroutine == 0)
+ return s2->attr.external == 1 ? compare_type_rank (s1, s2) : 0;
+ /* Now the type of procedure has been identified. */
if (s1->attr.function != s2->attr.function
|| s1->attr.subroutine != s2->attr.subroutine)
return 0;
+2009-02-26 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/39295
+ * gfortran.dg/interface_25.f90: New test.
+ * gfortran.dg/interface_26.f90: New test.
+
2009-02-26 Paul Thomas <pault@gcc.gnu.org>
PR fortran/39292
--- /dev/null
+! { dg-do compile }
+! Tests the fix for PR39295, in which the check of the interfaces
+! at lines 25 and 42 failed because opfunc1 is identified as a
+! function by usage, whereas opfunc2 is not.
+!
+! Contributed by Jon Hurst <jhurst@ucar.edu>
+!
+MODULE funcs
+CONTAINS
+ INTEGER FUNCTION test1(a,b,opfunc1)
+ INTEGER :: a,b
+ INTEGER, EXTERNAL :: opfunc1
+ test1 = opfunc1( a, b )
+ END FUNCTION test1
+ INTEGER FUNCTION sumInts(a,b)
+ INTEGER :: a,b
+ sumInts = a + b
+ END FUNCTION sumInts
+END MODULE funcs
+
+PROGRAM test
+ USE funcs
+ INTEGER :: rs
+ INTEGER, PARAMETER :: a = 2, b = 1
+ rs = recSum( a, b, test1, sumInts )
+ write(*,*) "Results", rs
+CONTAINS
+ RECURSIVE INTEGER FUNCTION recSum( a,b,UserFunction,UserOp ) RESULT( res )
+ IMPLICIT NONE
+ INTEGER :: a,b
+ INTERFACE
+ INTEGER FUNCTION UserFunction(a,b,opfunc2)
+ INTEGER :: a,b
+ INTEGER, EXTERNAL :: opfunc2
+ END FUNCTION UserFunction
+ END INTERFACE
+ INTEGER, EXTERNAL :: UserOp
+
+ res = UserFunction( a,b, UserOp )
+
+ if( res .lt. 10 ) then
+ res = recSum( a, res, UserFunction, UserOp )
+ end if
+ END FUNCTION recSum
+END PROGRAM test
--- /dev/null
+! { dg-do compile }
+! Tests the fix for PR39295, in which the check of the interfaces
+! at lines 26 and 43 failed because opfunc1 is identified as a
+! function by usage, whereas opfunc2 is not. This testcase checks
+! that TKR is stll OK in these cases.
+!
+! Contributed by Jon Hurst <jhurst@ucar.edu>
+!
+MODULE funcs
+CONTAINS
+ INTEGER FUNCTION test1(a,b,opfunc1)
+ INTEGER :: a,b
+ INTEGER, EXTERNAL :: opfunc1
+ test1 = opfunc1( a, b )
+ END FUNCTION test1
+ INTEGER FUNCTION sumInts(a,b)
+ INTEGER :: a,b
+ sumInts = a + b
+ END FUNCTION sumInts
+END MODULE funcs
+
+PROGRAM test
+ USE funcs
+ INTEGER :: rs
+ INTEGER, PARAMETER :: a = 2, b = 1
+ rs = recSum( a, b, test1, sumInts ) ! { dg-error "Type/rank mismatch in argument" }
+ write(*,*) "Results", rs
+CONTAINS
+ RECURSIVE INTEGER FUNCTION recSum( a,b,UserFunction,UserOp ) RESULT( res )
+ IMPLICIT NONE
+ INTEGER :: a,b
+ INTERFACE
+ INTEGER FUNCTION UserFunction(a,b,opfunc2)
+ INTEGER :: a,b
+ REAL, EXTERNAL :: opfunc2
+ END FUNCTION UserFunction
+ END INTERFACE
+ INTEGER, EXTERNAL :: UserOp
+
+ res = UserFunction( a,b, UserOp )
+
+ if( res .lt. 10 ) then
+ res = recSum( a, res, UserFunction, UserOp )
+ end if
+ END FUNCTION recSum
+END PROGRAM test