https://gcc.gnu.org/g:90442fb421823153c4f762a2d26a0d700af2e6c3
commit r13-8443-g90442fb421823153c4f762a2d26a0d700af2e6c3
Author: Harald Anlauf <anl...@gmx.de>
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.
(cherry picked from commit db0b6746be075e43c8142585968483e125bb52d0)
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 8c1ae8c2f00..f39a7610073 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -4357,6 +4357,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;
@@ -5187,7 +5190,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 e9843e9549c..5cda94753d8 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -3259,6 +3259,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 <actual argument>
+ corresponding to an <assumed-rank> 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 %<NULL()%> without %<MOLD%> 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 %<NULL()%> without %<MOLD%> 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
