Dear all, here's a simple and obvious patch for a rejects-valid case when we pass a NULL() actual to an optional dummy for variants where there is no MOLD argument and it is also not required.
The testcase is an extended version of PR55978 comment#16 and cross-checked with Intel and NAG. Regtested on x86_64-pc-linux-gnu. I intend to commit soon unless there are objections. Thanks, Harald
From e92244c5539a537cff338b781d15acd58d4c86f1 Mon Sep 17 00:00:00 2001 From: Harald Anlauf <anl...@gmx.de> Date: Fri, 22 Mar 2024 18:17:15 +0100 Subject: [PATCH] Fortran: no size check passing NULL() without MOLD argument [PR55978] gcc/fortran/ChangeLog: PR fortran/55978 * interface.cc (gfc_compare_actual_formal): Skip size check for NULL() actual without MOLD argument. gcc/testsuite/ChangeLog: PR fortran/55978 * gfortran.dg/null_actual_5.f90: New test. --- gcc/fortran/interface.cc | 4 ++ gcc/testsuite/gfortran.dg/null_actual_5.f90 | 76 +++++++++++++++++++++ 2 files changed, 80 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/null_actual_5.f90 diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc index 64b90550be2..7b86a338bc1 100644 --- a/gcc/fortran/interface.cc +++ b/gcc/fortran/interface.cc @@ -3439,6 +3439,10 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (f->sym->ts.type == BT_CLASS) goto skip_size_check; + /* Skip size check for NULL() actual without MOLD argument. */ + if (a->expr->expr_type == EXPR_NULL && a->expr->ts.type == BT_UNKNOWN) + goto skip_size_check; + actual_size = get_expr_storage_size (a->expr); formal_size = get_sym_storage_size (f->sym); if (actual_size != 0 && actual_size < formal_size diff --git a/gcc/testsuite/gfortran.dg/null_actual_5.f90 b/gcc/testsuite/gfortran.dg/null_actual_5.f90 new file mode 100644 index 00000000000..1198715b7c8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/null_actual_5.f90 @@ -0,0 +1,76 @@ +! { dg-do compile } +! PR fortran/55978 +! +! Passing of NULL() with and without MOLD as actual argument +! +! Testcase derived from pr55978 comment#16 + +program pr55978_c16 + implicit none + + integer, pointer :: p(:) + integer, allocatable :: a(:) + character(10), pointer :: c + character(10), pointer :: cp(:) + + type t + integer, pointer :: p(:) + integer, allocatable :: a(:) + end type + + type(t) :: d + + ! (1) pointer + p => null() + call sub (p) + + ! (2) allocatable + call sub (a) + call sub (d%a) + + ! (3) pointer component + d%p => null () + call sub (d%p) + + ! (4) NULL + call sub (null (a)) ! OK + call sub (null (p)) ! OK + call sub (null (d%a)) ! OK + call sub (null (d%p)) ! OK + call sub (null ()) ! was erroneously rejected with: + ! Actual argument contains too few elements for dummy argument 'x' (1/4) + + call bla (null(c)) + call bla (null()) ! was erroneously rejected with: + ! Actual argument contains too few elements for dummy argument 'x' (1/10) + + call foo (null(cp)) + call foo (null()) + + call bar (null(cp)) + call bar (null()) ! was erroneously rejected with: + ! Actual argument contains too few elements for dummy argument 'x' (1/70) + +contains + + subroutine sub(x) + integer, intent(in), optional :: x(4) + if (present (x)) stop 1 + end + + subroutine bla(x) + character(len=10), intent(in), optional :: x + if (present (x)) stop 2 + end + + subroutine foo(x) + character(len=10), intent(in), optional :: x(:) + if (present (x)) stop 3 + end + + subroutine bar(x) + character(len=10), intent(in), optional :: x(7) + if (present (x)) stop 4 + end + +end -- 2.35.3