From 8ad15a0a8d0666e21f4217d8ba004b33bcaf383d Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Tue, 16 Jun 2009 11:06:13 +0200 Subject: [PATCH] re PR fortran/36947 (Attributes not fully checked comparing actual vs dummy procedure) 2009-06-16 Janus Weil PR fortran/36947 PR fortran/40039 * expr.c (gfc_check_pointer_assign): Call 'gfc_compare_interfaces' with error message. * gfortran.h (gfc_compare_interfaces): Additional argument. * interface.c (operator_correspondence): Removed. (gfc_compare_interfaces): Additional argument to return error message. Directly use the code from 'operator_correspondence' instead of calling the function. Check for OPTIONAL. Some rearrangements. (check_interface1): Call 'gfc_compare_interfaces' without error message. (compare_parameter): Call 'gfc_compare_interfaces' with error message. * resolve.c (check_generic_tbp_ambiguity): Call 'gfc_compare_interfaces' without error message. 2009-06-16 Janus Weil PR fortran/36947 PR fortran/40039 * gfortran.dg/dummy_procedure_1.f90: Extended test case. * gfortran.dg/interface_20.f90: Modified error messages. * gfortran.dg/interface_21.f90: Ditto. * gfortran.dg/interface_26.f90: Ditto. * gfortran.dg/interface_27.f90: Ditto. * gfortran.dg/interface_28.f90: Extended test case. * gfortran.dg/interface_29.f90: New. * gfortran.dg/proc_decl_7.f90: Modified error messages. * gfortran.dg/proc_decl_8.f90: Ditto. * gfortran.dg/proc_ptr_11.f90: Ditto. * gfortran.dg/proc_ptr_15.f90: Ditto. From-SVN: r148519 --- gcc/fortran/ChangeLog | 16 +++ gcc/fortran/expr.c | 8 +- gcc/fortran/gfortran.h | 2 +- gcc/fortran/interface.c | 165 ++++++++++++++---------- gcc/fortran/resolve.c | 2 +- gcc/testsuite/ChangeLog | 16 +++ gcc/testsuite/gfortran.dg/dummy_procedure_1.f90 | 4 + gcc/testsuite/gfortran.dg/interface_20.f90 | 2 +- gcc/testsuite/gfortran.dg/interface_21.f90 | 2 +- gcc/testsuite/gfortran.dg/interface_26.f90 | 2 +- gcc/testsuite/gfortran.dg/interface_27.f90 | 4 +- gcc/testsuite/gfortran.dg/interface_28.f90 | 16 ++- gcc/testsuite/gfortran.dg/interface_29.f90 | 52 ++++++++ gcc/testsuite/gfortran.dg/proc_decl_7.f90 | 2 +- gcc/testsuite/gfortran.dg/proc_decl_8.f90 | 2 +- gcc/testsuite/gfortran.dg/proc_ptr_11.f90 | 8 +- gcc/testsuite/gfortran.dg/proc_ptr_15.f90 | 8 +- 17 files changed, 214 insertions(+), 97 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/interface_29.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0616247..12aa9dc 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,19 @@ +2009-06-16 Janus Weil + + PR fortran/36947 + PR fortran/40039 + * expr.c (gfc_check_pointer_assign): Call 'gfc_compare_interfaces' with + error message. + * gfortran.h (gfc_compare_interfaces): Additional argument. + * interface.c (operator_correspondence): Removed. + (gfc_compare_interfaces): Additional argument to return error message. + Directly use the code from 'operator_correspondence' instead of calling + the function. Check for OPTIONAL. Some rearrangements. + (check_interface1): Call 'gfc_compare_interfaces' without error message. + (compare_parameter): Call 'gfc_compare_interfaces' with error message. + * resolve.c (check_generic_tbp_ambiguity): Call 'gfc_compare_interfaces' + without error message. + 2009-06-16 Tobias Burnus PR fortran/40383 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 9342719..13c6b63 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3142,6 +3142,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) /* Checks on rvalue for procedure pointer assignments. */ if (proc_pointer) { + char err[200]; attr = gfc_expr_attr (rvalue); if (!((rvalue->expr_type == EXPR_NULL) || (rvalue->expr_type == EXPR_FUNCTION && attr.proc_pointer) @@ -3181,10 +3182,11 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) return SUCCESS; if (rvalue->expr_type == EXPR_VARIABLE && !gfc_compare_interfaces (lvalue->symtree->n.sym, - rvalue->symtree->n.sym, 0, 1)) + rvalue->symtree->n.sym, 0, 1, err, + sizeof(err))) { - gfc_error ("Interfaces don't match " - "in procedure pointer assignment at %L", &rvalue->where); + gfc_error ("Interface mismatch in procedure pointer assignment " + "at %L: %s", &rvalue->where, err); return FAILURE; } return SUCCESS; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 95661d1..7b9c697 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2567,7 +2567,7 @@ gfc_try gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *); void gfc_free_interface (gfc_interface *); int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *); int gfc_compare_types (gfc_typespec *, gfc_typespec *); -int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, int, int); +int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, int, int, char *, int); void gfc_check_interfaces (gfc_namespace *); void gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *); gfc_symbol *gfc_search_interface (gfc_interface *, int, diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 6cd34fa..4954389 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -778,7 +778,7 @@ bad_repl: Since this test is asymmetric, it has to be called twice to make it symmetric. Returns nonzero if the argument lists are incompatible by this test. This subroutine implements rule 1 of section - 14.1.2.3. */ + 14.1.2.3 in the Fortran 95 standard. */ static int count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2) @@ -869,45 +869,6 @@ count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2) } -/* Perform the abbreviated correspondence test for operators. The - arguments cannot be optional and are always ordered correctly, - which makes this test much easier than that for generic tests. - - This subroutine is also used when comparing a formal and actual - argument list when an actual parameter is a dummy procedure, and in - procedure pointer assignments. In these cases, two formal interfaces must be - compared for equality which is what happens here. 'intent_flag' specifies - whether the intents of the arguments are required to match, which is not the - case for ambiguity checks. */ - -static int -operator_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2, - int intent_flag) -{ - for (;;) - { - /* Check existence. */ - if (f1 == NULL && f2 == NULL) - break; - if (f1 == NULL || f2 == NULL) - return 1; - - /* Check type and rank. */ - if (!compare_type_rank (f1->sym, f2->sym)) - return 1; - - /* Check intent. */ - if (intent_flag && (f1->sym->attr.intent != f2->sym->attr.intent)) - return 1; - - f1 = f1->next; - f2 = f2->next; - } - - return 0; -} - - /* Perform the correspondence test in rule 2 of section 14.1.2.3. Returns zero if no argument is found that satisfies rule 2, nonzero otherwise. @@ -968,17 +929,29 @@ generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2) /* 'Compare' two formal interfaces associated with a pair of symbols. We return nonzero if there exists an actual argument list that - would be ambiguous between the two interfaces, zero otherwise. */ + would be ambiguous between the two interfaces, zero otherwise. + 'intent_flag' specifies whether INTENT and OPTIONAL of the arguments are + required to match, which is not the case for ambiguity checks.*/ int gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag, - int intent_flag) + int intent_flag, char *errmsg, int err_len) { gfc_formal_arglist *f1, *f2; - if ((s1->attr.function && !s2->attr.function) - || (s1->attr.subroutine && s2->attr.function)) - return 0; + if (s1->attr.function && !s2->attr.function) + { + if (errmsg != NULL) + snprintf (errmsg, err_len, "'%s' is not a function", s2->name); + return 0; + } + + if (s1->attr.subroutine && s2->attr.function) + { + if (errmsg != NULL) + snprintf (errmsg, err_len, "'%s' is not a subroutine", s2->name); + return 0; + } /* If the arguments are functions, check type and kind (only for dummy procedures and procedure pointer assignments). */ @@ -988,22 +961,25 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag, if (s1->ts.type == BT_UNKNOWN) return 1; if ((s1->ts.type != s2->ts.type) || (s1->ts.kind != s2->ts.kind)) - return 0; + { + if (errmsg != NULL) + snprintf (errmsg, err_len, "Type/kind mismatch in return value " + "of '%s'", s2->name); + return 0; + } if (s1->attr.if_source == IFSRC_DECL) return 1; } - if (s1->attr.if_source == IFSRC_UNKNOWN) + if (s1->attr.if_source == IFSRC_UNKNOWN + || s2->attr.if_source == IFSRC_UNKNOWN) return 1; f1 = s1->formal; f2 = s2->formal; if (f1 == NULL && f2 == NULL) - return 1; /* Special case. */ - - if (count_types_test (f1, f2) || count_types_test (f2, f1)) - return 0; + return 1; /* Special case: No arguments. */ if (generic_flag) { @@ -1011,9 +987,58 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag, return 0; } else + /* Perform the abbreviated correspondence test for operators (the + arguments cannot be optional and are always ordered correctly). + This is also done when comparing interfaces for dummy procedures and in + procedure pointer assignments. */ + + for (;;) + { + /* Check existence. */ + if (f1 == NULL && f2 == NULL) + break; + if (f1 == NULL || f2 == NULL) + { + if (errmsg != NULL) + snprintf (errmsg, err_len, "'%s' has the wrong number of " + "arguments", s2->name); + return 0; + } + + /* Check type and rank. */ + if (!compare_type_rank (f1->sym, f2->sym)) + { + if (errmsg != NULL) + snprintf (errmsg, err_len, "Type/rank mismatch in argument '%s'", + f1->sym->name); + return 0; + } + + /* Check INTENT. */ + if (intent_flag && (f1->sym->attr.intent != f2->sym->attr.intent)) + { + snprintf (errmsg, err_len, "INTENT mismatch in argument '%s'", + f1->sym->name); + return 0; + } + + /* Check OPTIONAL. */ + if (intent_flag && (f1->sym->attr.optional != f2->sym->attr.optional)) + { + snprintf (errmsg, err_len, "OPTIONAL mismatch in argument '%s'", + f1->sym->name); + return 0; + } + + f1 = f1->next; + f2 = f2->next; + } + + if (count_types_test (f1, f2) || count_types_test (f2, f1)) { - if (operator_correspondence (f1, f2, intent_flag)) - return 0; + if (errmsg != NULL) + snprintf (errmsg, err_len, "Interface not matching"); + return 0; } return 1; @@ -1091,7 +1116,7 @@ check_interface1 (gfc_interface *p, gfc_interface *q0, if (p->sym->name == q->sym->name && p->sym->module == q->sym->module) continue; - if (gfc_compare_interfaces (p->sym, q->sym, generic_flag, 0)) + if (gfc_compare_interfaces (p->sym, q->sym, generic_flag, 0, NULL, 0)) { if (referenced) { @@ -1362,27 +1387,25 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, if (actual->ts.type == BT_PROCEDURE) { - if (formal->attr.flavor != FL_PROCEDURE) - goto proc_fail; - - if (formal->attr.function - && !compare_type_rank (formal, actual->symtree->n.sym)) - goto proc_fail; + char err[200]; - if (formal->attr.if_source == IFSRC_UNKNOWN - || actual->symtree->n.sym->attr.external) - return 1; /* Assume match. */ + if (formal->attr.flavor != FL_PROCEDURE) + { + if (where) + gfc_error ("Invalid procedure argument at %L", &actual->where); + return 0; + } - if (!gfc_compare_interfaces (formal, actual->symtree->n.sym, 0, 1)) - goto proc_fail; + if (!gfc_compare_interfaces (formal, actual->symtree->n.sym, 0, 1, err, + sizeof(err))) + { + if (where) + gfc_error ("Interface mismatch in dummy procedure '%s' at %L: %s", + formal->name, &actual->where, err); + return 0; + } return 1; - - proc_fail: - if (where) - gfc_error ("Type/rank mismatch in argument '%s' at %L", - formal->name, &actual->where); - return 0; } if ((actual->expr_type != EXPR_NULL || actual->ts.type != BT_UNKNOWN) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index fdde894..3a67042 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8593,7 +8593,7 @@ check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2, } /* Compare the interfaces. */ - if (gfc_compare_interfaces (sym1, sym2, 1, 0)) + if (gfc_compare_interfaces (sym1, sym2, 1, 0, NULL, 0)) { gfc_error ("'%s' and '%s' for GENERIC '%s' at %L are ambiguous", sym1->name, sym2->name, generic_name, &where); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index cf97ed1..b3a7612 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,19 @@ +2009-06-16 Janus Weil + + PR fortran/36947 + PR fortran/40039 + * gfortran.dg/dummy_procedure_1.f90: Extended test case. + * gfortran.dg/interface_20.f90: Modified error messages. + * gfortran.dg/interface_21.f90: Ditto. + * gfortran.dg/interface_26.f90: Ditto. + * gfortran.dg/interface_27.f90: Ditto. + * gfortran.dg/interface_28.f90: Extended test case. + * gfortran.dg/interface_29.f90: New. + * gfortran.dg/proc_decl_7.f90: Modified error messages. + * gfortran.dg/proc_decl_8.f90: Ditto. + * gfortran.dg/proc_ptr_11.f90: Ditto. + * gfortran.dg/proc_ptr_15.f90: Ditto. + 2009-06-16 Ira Rosen * gcc.dg/vect/vect-outer-4g.c: Don't look for pattern not allowed diff --git a/gcc/testsuite/gfortran.dg/dummy_procedure_1.f90 b/gcc/testsuite/gfortran.dg/dummy_procedure_1.f90 index 6d68143..57d4bc3 100644 --- a/gcc/testsuite/gfortran.dg/dummy_procedure_1.f90 +++ b/gcc/testsuite/gfortran.dg/dummy_procedure_1.f90 @@ -21,6 +21,9 @@ contains end function f end interface end subroutine s1 + subroutine s2(x) + integer :: x + end subroutine end module m1 use m1 @@ -38,6 +41,7 @@ end module m1 call s1(x) ! explicit interface call s1(y) ! declared external call s1(z) ! { dg-error "Expected a procedure for argument" } + call s2(x) ! { dg-error "Invalid procedure argument" } contains integer function w() w = 1 diff --git a/gcc/testsuite/gfortran.dg/interface_20.f90 b/gcc/testsuite/gfortran.dg/interface_20.f90 index 2d7df47..829add2 100644 --- a/gcc/testsuite/gfortran.dg/interface_20.f90 +++ b/gcc/testsuite/gfortran.dg/interface_20.f90 @@ -16,5 +16,5 @@ end module m use m implicit none intrinsic cos -call sub(cos) ! { dg-error "Type/rank mismatch in argument" } +call sub(cos) ! { dg-error "wrong number of arguments" } end diff --git a/gcc/testsuite/gfortran.dg/interface_21.f90 b/gcc/testsuite/gfortran.dg/interface_21.f90 index fea6507..e3db771 100644 --- a/gcc/testsuite/gfortran.dg/interface_21.f90 +++ b/gcc/testsuite/gfortran.dg/interface_21.f90 @@ -18,5 +18,5 @@ end module m use m implicit none EXTERNAL foo ! implicit interface is undefined -call sub(foo) ! { dg-error "Type/rank mismatch in argument" } +call sub(foo) ! { dg-error "is not a function" } end diff --git a/gcc/testsuite/gfortran.dg/interface_26.f90 b/gcc/testsuite/gfortran.dg/interface_26.f90 index 0778345..c1af6c6 100644 --- a/gcc/testsuite/gfortran.dg/interface_26.f90 +++ b/gcc/testsuite/gfortran.dg/interface_26.f90 @@ -37,7 +37,7 @@ CONTAINS END INTERFACE INTEGER, EXTERNAL :: UserOp - res = UserFunction( a,b, UserOp ) ! { dg-error "Type/rank mismatch in argument" } + res = UserFunction( a,b, UserOp ) ! { dg-error "Type/kind mismatch in return value" } if( res .lt. 10 ) then res = recSum( a, res, UserFunction, UserOp ) diff --git a/gcc/testsuite/gfortran.dg/interface_27.f90 b/gcc/testsuite/gfortran.dg/interface_27.f90 index a3f1e4b..71975b6 100644 --- a/gcc/testsuite/gfortran.dg/interface_27.f90 +++ b/gcc/testsuite/gfortran.dg/interface_27.f90 @@ -31,8 +31,8 @@ subroutine caller end interface pointer :: p - call a(4.3,func) ! { dg-error "Type/rank mismatch in argument" } - p => func ! { dg-error "Interfaces don't match in procedure pointer assignment" } + call a(4.3,func) ! { dg-error "INTENT mismatch in argument" } + p => func ! { dg-error "INTENT mismatch in argument" } end subroutine end module diff --git a/gcc/testsuite/gfortran.dg/interface_28.f90 b/gcc/testsuite/gfortran.dg/interface_28.f90 index 53495a4..42a8208 100644 --- a/gcc/testsuite/gfortran.dg/interface_28.f90 +++ b/gcc/testsuite/gfortran.dg/interface_28.f90 @@ -2,7 +2,8 @@ ! ! PR 36947: Attributes not fully checked comparing actual vs dummy procedure ! -! Contributed by Walter Spector +! Original test case by Walter Spector +! Modified by Janus Weil module testsub contains @@ -12,7 +13,6 @@ module testsub integer, intent(in), optional:: x end subroutine end interface - print *, "In test(), about to call sub()" call sub() end subroutine end module @@ -20,9 +20,12 @@ end module module sub contains subroutine subActual(x) - ! actual subroutine's argment is different in intent and optional - integer, intent(inout):: x - print *, "In subActual():", x + ! actual subroutine's argment is different in intent + integer, intent(inout),optional:: x + end subroutine + subroutine subActual2(x) + ! actual subroutine's argment is missing OPTIONAL + integer, intent(in):: x end subroutine end module @@ -32,7 +35,8 @@ program interfaceCheck integer :: a - call test(subActual) ! { dg-error "Type/rank mismatch in argument" } + call test(subActual) ! { dg-error "INTENT mismatch in argument" } + call test(subActual2) ! { dg-error "OPTIONAL mismatch in argument" } end program ! { dg-final { cleanup-modules "sub testsub" } } diff --git a/gcc/testsuite/gfortran.dg/interface_29.f90 b/gcc/testsuite/gfortran.dg/interface_29.f90 new file mode 100644 index 0000000..e94571f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_29.f90 @@ -0,0 +1,52 @@ +! { dg-do compile } +! +! PR 36947: Attributes not fully checked comparing actual vs dummy procedure +! +! Contributed by Tobias Burnus + +module m +interface foo + module procedure one, two +end interface foo +contains +subroutine one(op,op2) + interface + subroutine op(x, y) + complex, intent(in) :: x(:) + complex, intent(out) :: y(:) + end subroutine op + subroutine op2(x, y) + complex, intent(in) :: x(:) + complex, intent(out) :: y(:) + end subroutine op2 + end interface +end subroutine one +subroutine two(ops,i,j) + interface + subroutine op(x, y) + complex, intent(in) :: x(:) + complex, intent(out) :: y(:) + end subroutine op + end interface + real :: i,j +end subroutine two +end module m + +module test +contains +subroutine bar() + use m + call foo(precond_prop,prop2) +end subroutine bar + subroutine precond_prop(x, y) + complex, intent(in) :: x(:) + complex, intent(out) :: y(:) + end subroutine + subroutine prop2(x, y) + complex, intent(in) :: x(:) + complex, intent(out) :: y(:) + end subroutine +end module test + +! { dg-final { cleanup-modules "m" } } + diff --git a/gcc/testsuite/gfortran.dg/proc_decl_7.f90 b/gcc/testsuite/gfortran.dg/proc_decl_7.f90 index 79f4137..c8c2a81 100644 --- a/gcc/testsuite/gfortran.dg/proc_decl_7.f90 +++ b/gcc/testsuite/gfortran.dg/proc_decl_7.f90 @@ -16,6 +16,6 @@ end module m use m implicit none intrinsic cos -call sub(cos) ! { dg-error "Type/rank mismatch in argument" } +call sub(cos) ! { dg-error "wrong number of arguments" } end ! { dg-final { cleanup-modules "m" } } diff --git a/gcc/testsuite/gfortran.dg/proc_decl_8.f90 b/gcc/testsuite/gfortran.dg/proc_decl_8.f90 index 67c1ddb..2d3514e 100644 --- a/gcc/testsuite/gfortran.dg/proc_decl_8.f90 +++ b/gcc/testsuite/gfortran.dg/proc_decl_8.f90 @@ -20,6 +20,6 @@ use m implicit none EXTERNAL foo ! interface is undefined procedure(cos) :: foo ! { dg-error "Duplicate EXTERNAL attribute specified" } -call sub(foo) ! { dg-error "Type/rank mismatch in argument" } +call sub(foo) ! { dg-error "is not a function" } end ! { dg-final { cleanup-modules "m" } } diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_11.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_11.f90 index 92d6542..469ebd4 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_11.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_11.f90 @@ -27,7 +27,7 @@ program bsp end function p3 end interface - pptr => add ! { dg-error "Interfaces don't match" } + pptr => add ! { dg-error "is not a subroutine" } q => add @@ -40,11 +40,11 @@ program bsp p2 => p1 p1 => p2 - p1 => abs ! { dg-error "Interfaces don't match" } - p2 => abs ! { dg-error "Interfaces don't match" } + p1 => abs ! { dg-error "Type/kind mismatch in return value" } + p2 => abs ! { dg-error "Type/kind mismatch in return value" } p3 => dsin - p3 => sin ! { dg-error "Interfaces don't match" } + p3 => sin ! { dg-error "Type/kind mismatch in return value" } contains diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_15.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_15.f90 index f95d280..57269b0 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_15.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_15.f90 @@ -19,10 +19,10 @@ p4 => p2 p6 => p1 ! invalid -p1 => iabs ! { dg-error "Interfaces don't match" } -p1 => p2 ! { dg-error "Interfaces don't match" } -p1 => p5 ! { dg-error "Interfaces don't match" } -p6 => iabs ! { dg-error "Interfaces don't match" } +p1 => iabs ! { dg-error "Type/kind mismatch in return value" } +p1 => p2 ! { dg-error "Type/kind mismatch in return value" } +p1 => p5 ! { dg-error "Type/kind mismatch in return value" } +p6 => iabs ! { dg-error "Type/kind mismatch in return value" } contains -- 2.7.4