From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2071) id 9B5AD3858C5F; Fri, 1 Mar 2024 18:22:55 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 9B5AD3858C5F DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1709317376; bh=PC1f6nGExzTmOp+nfjU1bSISoIr5eIJsqHTOAf2HsGg=; h=From:To:Subject:Date:From; b=erCFT9GCf1Gzwd/1ju46BN2IRfUR/UqM3JaLYhyZ22zhVgcz6iZ++dBFoWMky2N8p vKMgFsN9KLVae2QxXKjuqCIsfPUUmlOMOCfJ2CCUosuymg2GZZFcc2+JXqIRLhVEYT oK5+UMTF5vj05s0sFp0obRWDZHM5rPHeME5iNbY8= MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Harald Anlauf To: gcc-cvs@gcc.gnu.org Subject: [gcc r14-9261] Fortran: improve checks of NULL without MOLD as actual argument [PR104819] X-Act-Checkin: gcc X-Git-Author: Harald Anlauf X-Git-Refname: refs/heads/master X-Git-Oldrev: a6a1920b592b58c38137c5c891b3bbb02b084f38 X-Git-Newrev: db0b6746be075e43c8142585968483e125bb52d0 Message-Id: <20240301182256.9B5AD3858C5F@sourceware.org> Date: Fri, 1 Mar 2024 18:22:55 +0000 (GMT) List-Id: https://gcc.gnu.org/g:db0b6746be075e43c8142585968483e125bb52d0 commit r14-9261-gdb0b6746be075e43c8142585968483e125bb52d0 Author: Harald Anlauf Date: Fri Mar 1 19:21:27 2024 +0100 Fortran: improve checks of NULL without MOLD as actual argument [PR104819] gcc/fortran/ChangeLog: PR fortran/104819 * check.cc (gfc_check_null): Handle nested NULL()s. (is_c_interoperable): Check for MOLD argument of NULL() as part of the interoperability check. * interface.cc (gfc_compare_actual_formal): Extend checks for NULL() actual arguments for presence of MOLD argument when required by Interp J3/22-146. gcc/testsuite/ChangeLog: PR fortran/104819 * gfortran.dg/assumed_rank_9.f90: Adjust testcase use of NULL(). * gfortran.dg/pr101329.f90: Adjust testcase to conform to interp. * gfortran.dg/null_actual_4.f90: New test. Diff: --- gcc/fortran/check.cc | 5 +++- gcc/fortran/interface.cc | 30 ++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/assumed_rank_9.f90 | 13 +++++++---- gcc/testsuite/gfortran.dg/null_actual_4.f90 | 35 ++++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/pr101329.f90 | 4 ++-- 5 files changed, 79 insertions(+), 8 deletions(-) diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index d661cf37f01..db74dcf3f40 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -4384,6 +4384,9 @@ gfc_check_null (gfc_expr *mold) if (mold == NULL) return true; + if (mold->expr_type == EXPR_NULL) + return true; + if (!variable_check (mold, 0, true)) return false; @@ -5216,7 +5219,7 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc, bool c_f_ptr) { *msg = NULL; - if (expr->expr_type == EXPR_NULL) + if (expr->expr_type == EXPR_NULL && expr->ts.type == BT_UNKNOWN) { *msg = "NULL() is not interoperable"; return false; diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc index 231f2f252af..64b90550be2 100644 --- a/gcc/fortran/interface.cc +++ b/gcc/fortran/interface.cc @@ -3296,6 +3296,36 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, && a->expr->ts.type != BT_ASSUMED) gfc_find_vtab (&a->expr->ts); + /* Interp J3/22-146: + "If the context of the reference to NULL is an + corresponding to an dummy argument, MOLD shall be + present." */ + if (a->expr->expr_type == EXPR_NULL + && a->expr->ts.type == BT_UNKNOWN + && f->sym->as + && f->sym->as->type == AS_ASSUMED_RANK) + { + gfc_error ("Intrinsic % without % argument at %L " + "passed to assumed-rank dummy %qs", + &a->expr->where, f->sym->name); + ok = false; + goto match; + } + + if (a->expr->expr_type == EXPR_NULL + && a->expr->ts.type == BT_UNKNOWN + && f->sym->ts.type == BT_CHARACTER + && !f->sym->ts.deferred + && f->sym->ts.u.cl + && f->sym->ts.u.cl->length == NULL) + { + gfc_error ("Intrinsic % without % argument at %L " + "passed to assumed-length dummy %qs", + &a->expr->where, f->sym->name); + ok = false; + goto match; + } + if (a->expr->expr_type == EXPR_NULL && ((f->sym->ts.type != BT_CLASS && !f->sym->attr.pointer && (f->sym->attr.allocatable || !f->sym->attr.optional diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_9.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_9.f90 index 1296d068959..5e59ec136c9 100644 --- a/gcc/testsuite/gfortran.dg/assumed_rank_9.f90 +++ b/gcc/testsuite/gfortran.dg/assumed_rank_9.f90 @@ -26,19 +26,20 @@ program main type(t), target :: y class(t), allocatable, target :: yac - + type(t), pointer :: ypt + y%i = 489 allocate (yac) yac%i = 489 j = 0 call fc() - call fc(null()) + call fc(null(yac)) call fc(y) call fc(yac) if (j /= 2) STOP 1 j = 0 - call gc(null()) +! call gc(null(yac)) ! ICE call gc(y) call gc(yac) deallocate (yac) @@ -54,13 +55,14 @@ program main j = 0 call ft() - call ft(null()) + call ft(null(yac)) call ft(y) call ft(yac) if (j /= 2) STOP 4 j = 0 - call gt(null()) + call gt(null(ypt)) +! call gt(null(yac)) ! ICE call gt(y) call gt(yac) deallocate (yac) @@ -73,6 +75,7 @@ program main yac%i = 489 call ht(yac) if (j /= 1) STOP 6 + deallocate (yac) contains diff --git a/gcc/testsuite/gfortran.dg/null_actual_4.f90 b/gcc/testsuite/gfortran.dg/null_actual_4.f90 new file mode 100644 index 00000000000..e03d5c8f7de --- /dev/null +++ b/gcc/testsuite/gfortran.dg/null_actual_4.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } +! PR fortran/104819 +! +! Reject NULL without MOLD as actual to an assumed-rank dummy. +! See also interpretation request at +! https://j3-fortran.org/doc/year/22/22-101r1.txt +! +! Test nested NULL() + +program p + implicit none + integer, pointer :: a, a3(:,:,:) + character(10), pointer :: c + + call foo (a) + call foo (a3) + call foo (null (a)) + call foo (null (a3)) + call foo (null (null (a))) ! Valid: nested NULL()s + call foo (null (null (a3))) ! Valid: nested NULL()s + call foo (null ()) ! { dg-error "passed to assumed-rank dummy" } + + call str (null (c)) + call str (null (null (c))) + call str (null ()) ! { dg-error "passed to assumed-length dummy" } +contains + subroutine foo (x) + integer, pointer, intent(in) :: x(..) + print *, rank (x) + end + + subroutine str (x) + character(len=*), pointer, intent(in) :: x + end +end diff --git a/gcc/testsuite/gfortran.dg/pr101329.f90 b/gcc/testsuite/gfortran.dg/pr101329.f90 index b82210d4e28..aca171bd4f8 100644 --- a/gcc/testsuite/gfortran.dg/pr101329.f90 +++ b/gcc/testsuite/gfortran.dg/pr101329.f90 @@ -8,6 +8,6 @@ program p integer(c_int64_t), pointer :: ip8 print *, c_sizeof (c_null_ptr) ! valid print *, c_sizeof (null ()) ! { dg-error "is not interoperable" } - print *, c_sizeof (null (ip4)) ! { dg-error "is not interoperable" } - print *, c_sizeof (null (ip8)) ! { dg-error "is not interoperable" } + print *, c_sizeof (null (ip4)) ! valid + print *, c_sizeof (null (ip8)) ! valid end