GCC 4.7 added some additional checks for type-bound procedure
overriding. However, doing so it weakened the check whether the nonpass
argument has the same type.
While for normal arguments, passing the parent type to an extended type
is fine, for overriding the type (of nonpass arguments) must be exactly
the same as in the original type.
The attached patch re-adds this check.
Build and regtested on x86-64-gnu-linux.
OK for the trunk and the 4.7/4.8 branches?
Tobias
2013-05-10 Tobias Burnus <bur...@net-b.de>
PR fortran/57217
* interface.c (gfc_check_typebound_override): Check whether
nonpass types are identical same.
2013-05-10 Tobias Burnus <bur...@net-b.de>
PR fortran/57217
* gfortran.dg/typebound_override_4.f90: New.
* gfortran.dg/typebound_proc_6.f03: Update dg-error.
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 1b967fa..8f22e4c 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -4128,6 +4128,17 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
}
check_type = proc_pass_arg != argpos && old_pass_arg != argpos;
+ if (check_type
+ && (!gfc_compare_types (&proc_formal->sym->ts, &old_formal->sym->ts)
+ || !gfc_compare_types (&old_formal->sym->ts,
+ &proc_formal->sym->ts)))
+ {
+ gfc_error ("Argument type mismatch for the overriding procedure "
+ "'%s' at %L: %s shall be %s", proc->name, &where,
+ gfc_typename (&proc_formal->sym->ts),
+ gfc_typename (&old_formal->sym->ts));
+ return false;
+ }
if (!check_dummy_characteristics (proc_formal->sym, old_formal->sym,
check_type, err, sizeof(err)))
{
diff --git a/gcc/testsuite/gfortran.dg/typebound_override_4.f90 b/gcc/testsuite/gfortran.dg/typebound_override_4.f90
new file mode 100644
index 0000000..e6f9805
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_override_4.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+!
+! PR fortran/57217
+!
+! Contributed Salvatore Filippone
+!
+module base_mod
+ type base_type
+ integer :: kind
+ contains
+ procedure, pass(map) :: clone => base_clone
+ end type base_type
+contains
+ subroutine base_clone(map,mapout,info)
+ implicit none
+ class(base_type), intent(inout) :: map
+ class(base_type), intent(inout) :: mapout
+ integer :: info
+ end subroutine base_clone
+end module base_mod
+
+module r_mod
+ use base_mod
+ type, extends(base_type) :: r_type
+ real :: dat
+ contains
+ procedure, pass(map) :: clone => r_clone ! { dg-error "Argument type mismatch for the overriding procedure 'clone' at .1.: CLASS.r_type. shall be CLASS.base_type." }
+ end type r_type
+contains
+ subroutine r_clone(map,mapout,info)
+ implicit none
+ class(r_type), intent(inout) :: map
+ class(r_type), intent(inout) :: mapout
+ integer :: info
+ end subroutine r_clone
+end module r_mod
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_6.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_6.f03
index 3a32cbc..1fe2580 100644
--- a/gcc/testsuite/gfortran.dg/typebound_proc_6.f03
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_6.f03
@@ -89,7 +89,7 @@ MODULE testmod
! For corresponding dummy arguments.
PROCEDURE, PASS :: corresp1 => proc_tmeint ! Ok.
PROCEDURE, PASS :: corresp2 => proc_tmeintx ! { dg-error "should be named 'a'" }
- PROCEDURE, PASS :: corresp3 => proc_tmereal ! { dg-error "Type/rank mismatch in argument 'a'" }
+ PROCEDURE, PASS :: corresp3 => proc_tmereal ! { dg-error "Argument type mismatch for the overriding procedure 'corresp3' at .1.: REAL.4. shall be INTEGER.4." }
END TYPE t
