Hi Tobias,
> Two points regarding future patches:
>
> Please attach files with a file suffix – such that the MIME
> type is "text/..." and not "application/octet-stream".
> (.patch, .diff or even a simple .txt should do.)
noted.
> Additionally, given that we now use GIT and start to move
> to autogenerating changelogs, can you post the commit-log
> text instead of (only) the changelog entry?
> See: https://gcc.gnu.org/pipermail/gcc/2020-April/thread.html#500
> ("Automatically generated ChangeLog files")
> and follow-up in May
> https://gcc.gnu.org/pipermail/gcc/2020-April/000500.html
The current git workflow for gcc is IMO a PITA. Hopefully somebody
writes a wiki entry with best practices, so that fortran developers
do not have to dig in the gcc archives.
Automatic generation of ChangeLog files could have been considered
as part of the transition svn->git.
> Regarding the patch:
>
> + gfc_error ("NULL pointer at %L is not permitted as actual argument "
> + "of %qs intrinsic function", &x->where,
>
> I wonder whether "argument of" should be rather "argument to" and
> "NULL pointer" should be "NULL" as Fortran only talks about
> "disassociated" pointers etc. and not about NULL pointers.
> (I know that this is unchanged from the original code.)
Done. See below.
> Otherwise it LGTM.
>
> Tobias
Thanks for the review!
Harald
Here's what I actually committed. Hopefully this is close to what it should
be...
PR fortran/93366 - ICE on invalid, reject invalid use of NULL() as argument
gcc/fortran/ChangeLog:
2020-05-05 Steve Kargl <ka...@gcc.gnu.org>
Harald Anlauf <anl...@gmx.de>
PR fortran/93366
* check.c (gfc_check_associated, invalid_null_arg): Factorize
check for presence of invalid NULL() argument.
(gfc_check_kind, gfc_check_merge, gfc_check_shape)
(gfc_check_sizeof, gfc_check_spread, gfc_check_transfer): Use this
check for presence of invalid NULL() arguments.
gcc/testsuite/ChangeLog:
2020-05-05 Harald Anlauf <anl...@gmx.de>
PR fortran/93366
* gfortran.dg/pr93366.f90: New test.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index cdabbf5e12a..0afb96c0414 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1431,6 +1431,18 @@ gfc_check_x_yd (gfc_expr *x, gfc_expr *y)
return true;
}
+static bool
+invalid_null_arg (gfc_expr *x)
+{
+ if (x->expr_type == EXPR_NULL)
+ {
+ gfc_error ("NULL at %L is not permitted as actual argument "
+ "to %qs intrinsic function", &x->where,
+ gfc_current_intrinsic);
+ return true;
+ }
+ return false;
+}
bool
gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
@@ -1438,12 +1450,9 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
symbol_attribute attr1, attr2;
int i;
bool t;
- locus *where;
- where = &pointer->where;
-
- if (pointer->expr_type == EXPR_NULL)
- goto null_arg;
+ if (invalid_null_arg (pointer))
+ return false;
attr1 = gfc_expr_attr (pointer);
@@ -1468,9 +1477,8 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
if (target == NULL)
return true;
- where = &target->where;
- if (target->expr_type == EXPR_NULL)
- goto null_arg;
+ if (invalid_null_arg (target))
+ return false;
if (target->expr_type == EXPR_VARIABLE || target->expr_type == EXPR_FUNCTION)
attr2 = gfc_expr_attr (target);
@@ -1518,13 +1526,6 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
}
}
return t;
-
-null_arg:
-
- gfc_error ("NULL pointer at %L is not permitted as actual argument "
- "of %qs intrinsic function", where, gfc_current_intrinsic);
- return false;
-
}
@@ -3373,6 +3374,9 @@ gfc_check_kill_sub (gfc_expr *pid, gfc_expr *sig, gfc_expr *status)
bool
gfc_check_kind (gfc_expr *x)
{
+ if (invalid_null_arg (x))
+ return false;
+
if (gfc_bt_struct (x->ts.type) || x->ts.type == BT_CLASS)
{
gfc_error ("%qs argument of %qs intrinsic at %L must be of "
@@ -4134,6 +4138,12 @@ gfc_check_transf_bit_intrins (gfc_actual_arglist *ap)
bool
gfc_check_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
{
+ if (invalid_null_arg (tsource))
+ return false;
+
+ if (invalid_null_arg (fsource))
+ return false;
+
if (!same_type_check (tsource, 0, fsource, 1))
return false;
@@ -5051,6 +5061,9 @@ gfc_check_shape (gfc_expr *source, gfc_expr *kind)
{
gfc_array_ref *ar;
+ if (invalid_null_arg (source))
+ return false;
+
if (source->rank == 0 || source->expr_type != EXPR_VARIABLE)
return true;
@@ -5133,6 +5146,9 @@ gfc_check_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
bool
gfc_check_sizeof (gfc_expr *arg)
{
+ if (invalid_null_arg (arg))
+ return false;
+
if (arg->ts.type == BT_PROCEDURE)
{
gfc_error ("%qs argument of %qs intrinsic at %L shall not be a procedure",
@@ -5618,6 +5634,9 @@ gfc_check_sngl (gfc_expr *a)
bool
gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies)
{
+ if (invalid_null_arg (source))
+ return false;
+
if (source->rank >= GFC_MAX_DIMENSIONS)
{
gfc_error ("%qs argument of %qs intrinsic at %L must be less "
@@ -6148,6 +6167,9 @@ gfc_check_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
size_t source_size;
size_t result_size;
+ if (invalid_null_arg (source))
+ return false;
+
/* SOURCE shall be a scalar or array of any type. */
if (source->ts.type == BT_PROCEDURE
&& source->symtree->n.sym->attr.subroutine == 1)
@@ -6164,6 +6186,9 @@ gfc_check_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
if (mold->ts.type == BT_BOZ && illegal_boz_arg (mold))
return false;
+ if (invalid_null_arg (mold))
+ return false;
+
/* MOLD shall be a scalar or array of any type. */
if (mold->ts.type == BT_PROCEDURE
&& mold->symtree->n.sym->attr.subroutine == 1)
diff --git a/gcc/testsuite/gfortran.dg/pr93366.f90 b/gcc/testsuite/gfortran.dg/pr93366.f90
new file mode 100644
index 00000000000..3cb6d1d16da
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93366.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!
+! PR fortran/93366 - ICE on invalid, reject invalid use of NULL() as argument
+
+program p
+ print *, kind (null()) ! { dg-error "NULL at" }
+ print *, [ merge(null(), [1] ,.true.) ] ! { dg-error "NULL at" }
+ print *, [ merge([1] , null(),.true.) ] ! { dg-error "NULL at" }
+ print *, [ merge(null(), null(),.true.) ] ! { dg-error "NULL at" }
+ print *, shape (null()) ! { dg-error "NULL at" }
+ print *, sizeof (null()) ! { dg-error "NULL at" }
+ print *, spread (null(),1,1) ! { dg-error "NULL at" }
+ print *, transfer ( 1 , null()) ! { dg-error "NULL at" }
+ print *, transfer ([1], null()) ! { dg-error "NULL at" }
+ print *, transfer (null(), 1) ! { dg-error "NULL at" }
+ print *, transfer (null(), [1]) ! { dg-error "NULL at" }
+ print *, transfer (null(), null()) ! { dg-error "NULL at" }
+end
