From 22a0a78022d0bd05385d18ab222cd6c1c8dc29b1 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Mon, 22 Jun 2009 04:41:10 +0000 Subject: [PATCH] re PR fortran/40443 (Elemental procedure in genericl interface incorrectly selected in preference to specific procedure) 2009-06-22 Paul Thomas 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 PR fortran/40443 * gfortran.dg/generic_18.f90: New test. From-SVN: r148776 --- gcc/fortran/interface.c | 14 +++++- gcc/testsuite/gfortran.dg/generic_18.f90 | 54 ++++++++++++++++++++++++ 2 files changed, 66 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/generic_18.f90 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 7d26fe444f9..53cc95fe76e 100644 --- a/gcc/fortran/interface.c +++ b/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; } diff --git a/gcc/testsuite/gfortran.dg/generic_18.f90 b/gcc/testsuite/gfortran.dg/generic_18.f90 new file mode 100644 index 00000000000..1e23838d712 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/generic_18.f90 @@ -0,0 +1,54 @@ +! { 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 +! +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" } }