From 0ce0e6e865f65b34fd20e8ae912ff7307fb5b832 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Tue, 14 Aug 2018 21:09:33 +0200 Subject: [PATCH] re PR fortran/86116 (Ambiguous generic interface not recognised) 2018-08-14 Janus Weil PR fortran/86116 * interface.c (compare_type): Remove a CLASS/TYPE check. (compare_type_characteristics): New function that behaves like the old 'compare_type'. (gfc_check_dummy_characteristics, gfc_check_result_characteristics): Call 'compare_type_characteristics' instead of 'compare_type'. 2018-08-14 Janus Weil PR fortran/86116 * gfortran.dg/generic_34.f90: New test case. From-SVN: r263540 --- gcc/fortran/ChangeLog | 9 ++++++++ gcc/fortran/interface.c | 14 +++++++++--- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/generic_34.f90 | 27 ++++++++++++++++++++++++ 4 files changed, 52 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/generic_34.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6c39d9cc5d5..e4403523301 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2018-08-14 Janus Weil + + PR fortran/86116 + * interface.c (compare_type): Remove a CLASS/TYPE check. + (compare_type_characteristics): New function that behaves like the old + 'compare_type'. + (gfc_check_dummy_characteristics, gfc_check_result_characteristics): + Call 'compare_type_characteristics' instead of 'compare_type'. + 2018-08-12 Paul Thomas PR fortran/66679 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 32aae0eda55..f85c76bad0f 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -735,13 +735,20 @@ compare_type (gfc_symbol *s1, gfc_symbol *s2) if (s2->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK)) return true; + return gfc_compare_types (&s1->ts, &s2->ts) || s2->ts.type == BT_ASSUMED; +} + + +static bool +compare_type_characteristics (gfc_symbol *s1, gfc_symbol *s2) +{ /* TYPE and CLASS of the same declared type are type compatible, but have different characteristics. */ if ((s1->ts.type == BT_CLASS && s2->ts.type == BT_DERIVED) || (s1->ts.type == BT_DERIVED && s2->ts.type == BT_CLASS)) return false; - return gfc_compare_types (&s1->ts, &s2->ts) || s2->ts.type == BT_ASSUMED; + return compare_type (s1, s2); } @@ -1309,7 +1316,8 @@ gfc_check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, /* Check type and rank. */ if (type_must_agree) { - if (!compare_type (s1, s2) || !compare_type (s2, s1)) + if (!compare_type_characteristics (s1, s2) + || !compare_type_characteristics (s2, s1)) { snprintf (errmsg, err_len, "Type mismatch in argument '%s' (%s/%s)", s1->name, gfc_typename (&s1->ts), gfc_typename (&s2->ts)); @@ -1528,7 +1536,7 @@ gfc_check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, return true; /* Check type and rank. */ - if (!compare_type (r1, r2)) + if (!compare_type_characteristics (r1, r2)) { snprintf (errmsg, err_len, "Type mismatch in function result (%s/%s)", gfc_typename (&r1->ts), gfc_typename (&r2->ts)); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 930db3a3514..3bbc706c121 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-08-14 Janus Weil + + PR fortran/86116 + * gfortran.dg/generic_34.f90: New test case. + 2018-08-13 Marek Polacek PR c++/57891 diff --git a/gcc/testsuite/gfortran.dg/generic_34.f90 b/gcc/testsuite/gfortran.dg/generic_34.f90 new file mode 100644 index 00000000000..1bcbfa089fa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/generic_34.f90 @@ -0,0 +1,27 @@ +! { dg-do compile } +! +! PR 86116: [6/7/8/9 Regression] Ambiguous generic interface not recognised +! +! Contributed by martin + +module mod + + type :: t + end type t + + interface sub + module procedure s1 + module procedure s2 + end interface + +contains + + subroutine s1(x) ! { dg-error "Ambiguous interfaces in generic interface" } + type(t) :: x + end subroutine + + subroutine s2(x) ! { dg-error "Ambiguous interfaces in generic interface" } + class(*), allocatable :: x + end subroutine + +end -- 2.30.2