re PR fortran/40443 (Elemental procedure in genericl interface incorrectly…

re PR fortran/40443 (Elemental procedure in genericl interface incorrectly selected in preference to specific procedure)

2009-06-22  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/40443
	* interface.c (gfc_search_interface): Hold back a match to an
	elementary procedure until all other possibilities are
	exhausted.

2009-06-22  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/40443
	* gfortran.dg/generic_18.f90: New test.

From-SVN: r148776

gcc/fortran/interface.c

@@ -2425,6 +2425,7 @@ gfc_symbol *
 gfc_search_interface (gfc_interface *intr, int sub_flag,
 		      gfc_actual_arglist **ap)
 {
+  gfc_symbol *elem_sym = NULL;
   for (; intr; intr = intr->next)
     {
       if (sub_flag && intr->sym->attr.function)
@@ -2433,10 +2434,19 @@ gfc_search_interface (gfc_interface *intr, int sub_flag,
 	continue;
 
       if (gfc_arglist_matches_symbol (ap, intr->sym))
-	return intr->sym;
+	{
+	  /* Satisfy 12.4.4.1 such that an elemental match has lower
+	     weight than a non-elemental match.  */ 
+	  if (intr->sym->attr.elemental)
+	    {
+	      elem_sym = intr->sym;
+	      continue;
+	    }
+	  return intr->sym;
+	}
     }
 
-  return NULL;
+  return elem_sym ? elem_sym : NULL;
 }
 
 

gcc/testsuite/gfortran.dg/generic_18.f90

+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR40443 in which the final call to the generic
+! 'SpecElem' was resolved to the elemental rather than the specific
+! procedure, which is required by the second part of 12.4.4.1.
+!
+! Contributed by Ian Harvey <ian_harvey@bigpond.com>
+!
+MODULE SomeOptions
+  IMPLICIT NONE  
+  INTERFACE ElemSpec
+    MODULE PROCEDURE ElemProc
+    MODULE PROCEDURE SpecProc
+  END INTERFACE ElemSpec  
+  INTERFACE SpecElem
+    MODULE PROCEDURE SpecProc
+    MODULE PROCEDURE ElemProc
+  END INTERFACE SpecElem
+CONTAINS
+  ELEMENTAL SUBROUTINE ElemProc(a)  
+    CHARACTER, INTENT(OUT) :: a
+    !****
+    a = 'E'            
+  END SUBROUTINE ElemProc
+
+  SUBROUTINE SpecProc(a)  
+    CHARACTER, INTENT(OUT) :: a(:)
+    !****    
+    a = 'S'    
+  END SUBROUTINE SpecProc
+END MODULE SomeOptions
+
+PROGRAM MakeAChoice
+  USE SomeOptions  
+  IMPLICIT NONE
+  CHARACTER scalar, array(2)    
+  !****
+  CALL ElemSpec(scalar) ! Should choose the elemental (and does)
+  WRITE (*, 100) scalar
+  CALL ElemSpec(array)  ! Should choose the specific (and does)
+  WRITE (*, 100) array
+  !----
+  CALL SpecElem(scalar) ! Should choose the elemental (and does)
+  WRITE (*, 100) scalar
+  CALL SpecElem(array)  ! Should choose the specific (but didn't)
+  WRITE (*, 100) array  
+  !----
+  100 FORMAT(A,:,', ',A)
+END PROGRAM MakeAChoice
+! { dg-final { scan-tree-dump-times "specproc" 3 "original" } }
+! { dg-final { scan-tree-dump-times "elemproc" 3 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-modules "SomeOptions" } }