diff options
author | Harald Anlauf <anlauf@gmx.de> | 2024-03-22 18:17:15 +0100 |
---|---|---|
committer | Harald Anlauf <anlauf@gmx.de> | 2024-03-22 22:00:53 +0100 |
commit | c083a453dbe51853e26e02edd8b9346fb8618292 (patch) | |
tree | 1c0bef4d470bc4f14c366c9548d024c4bb8569f8 /gcc | |
parent | 65b7d1862e11784a0ce67ab758e06dd8aa65b181 (diff) | |
download | gcc-c083a453dbe51853e26e02edd8b9346fb8618292.zip gcc-c083a453dbe51853e26e02edd8b9346fb8618292.tar.gz gcc-c083a453dbe51853e26e02edd8b9346fb8618292.tar.bz2 |
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.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/interface.cc | 4 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/null_actual_5.f90 | 76 |
2 files changed, 80 insertions, 0 deletions
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc index 64b9055..7b86a33 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 0000000..1198715 --- /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 |