Dear all, the attached patch fixes the issue reported by Salvatore Filippone.
As Tobias already explained, we have the situation that resolution does not always resolve the ambiguity between deferred shape and assumed shape. The attached patch solves this by splitting the shape check into one for rank (to catch true deferred shape cases) and shape, the latter making an exception for the described situation. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald
From 11ca9550e60b2da71479157fa8a3e66868050c1b Mon Sep 17 00:00:00 2001 From: Harald Anlauf <[email protected]> Date: Tue, 24 Mar 2026 22:04:29 +0100 Subject: [PATCH] Fortran: fix rank/shape check in interface checking [PR124567] PR fortran/124567 gcc/fortran/ChangeLog: * interface.cc (gfc_check_dummy_characteristics): Split shape check into a separate check for rank and a check for shape, taking into account a corner case where the ambiguity between deferred shape and assumed shape has not been fully resolved at the time of checking. gcc/testsuite/ChangeLog: * gfortran.dg/pr124567.f90: New test. --- gcc/fortran/interface.cc | 11 ++++- gcc/testsuite/gfortran.dg/pr124567.f90 | 62 ++++++++++++++++++++++++++ 2 files changed, 72 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/pr124567.f90 diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc index d29cb3a3b82..8a19c14aa78 100644 --- a/gcc/fortran/interface.cc +++ b/gcc/fortran/interface.cc @@ -1554,6 +1554,13 @@ gfc_check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, int i, compval; gfc_expr *shape1, *shape2; + if (s1->as->rank != s2->as->rank) + { + snprintf (errmsg, err_len, "Rank mismatch in argument '%s' (%i/%i)", + s1->name, s1->as->rank, s2->as->rank); + return false; + } + /* Sometimes the ambiguity between deferred shape and assumed shape does not get resolved in module procedures, where the only explicit declaration of the dummy is in the interface. */ @@ -1567,7 +1574,9 @@ gfc_check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, s2->as->lower[i] = gfc_copy_expr (s1->as->lower[i]); } - if (s1->as->type != s2->as->type) + if (s1->as->type != s2->as->type + && !(s1->as->type == AS_DEFERRED + && s2->as->type == AS_ASSUMED_SHAPE)) { snprintf (errmsg, err_len, "Shape mismatch in argument '%s'", s1->name); diff --git a/gcc/testsuite/gfortran.dg/pr124567.f90 b/gcc/testsuite/gfortran.dg/pr124567.f90 new file mode 100644 index 00000000000..feb00f22214 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr124567.f90 @@ -0,0 +1,62 @@ +! { dg-do compile } +! +! PR fortran/124567 - overriding method not resolved correctly +! +! Contributed by Salvatore Filippone + +module psb_base_spm_mod + type :: psb_base_spm + end type psb_base_spm +end module psb_base_spm_mod + +module psb_r_base_spm_mod + use psb_base_spm_mod + type, extends(psb_base_spm) :: psb_r_base_spm + contains + procedure, pass(a) :: csgrw => psb_r_base_csgrw + end type psb_r_base_spm + + interface + subroutine psb_r_base_csgrw(a,iren) + import + class(psb_r_base_spm), intent(in) :: a + integer, intent(in), optional :: iren(:) + end subroutine psb_r_base_csgrw + end interface +end module psb_r_base_spm_mod + +module psb_d_mf_mat_mod + use psb_r_base_spm_mod + type, extends(psb_r_base_spm) :: psb_d_mf_spm + procedure(d_mf_mv), pass(a), pointer :: var_csmv => null() + contains + procedure, pass(a) :: csgrw => psb_d_mf_csgrw + procedure, pass(a) :: set_csmv => d_mf_set_csmv + end type psb_d_mf_spm + + interface + subroutine d_mf_mv(a,x,info) + import :: psb_d_mf_spm + class(psb_d_mf_spm), intent(in) :: a + real, intent(in) :: x(:) + integer, intent(out) :: info + end subroutine d_mf_mv + end interface + + interface + subroutine psb_d_mf_csgrw(a,iren) + import + class(psb_d_mf_spm), intent(in) :: a + integer, intent(in), optional :: iren(:) + end subroutine psb_d_mf_csgrw + end interface + +contains + subroutine d_mf_set_csmv(func,a) + implicit none + class(psb_d_mf_spm), intent(inout) :: a + procedure(d_mf_mv) :: func + a%var_csmv => func + return + end subroutine d_mf_set_csmv +end module psb_d_mf_mat_mod -- 2.51.0
