[Bug fortran/93366] ICE: Invalid expression in gfc_element_size

[kargl at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93366

kargl at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
           Priority|P3                          |P4
                 CC|                            |kargl at gcc dot gnu.org

--- Comment #2 from kargl at gcc dot gnu.org ---
patch against last SVN revision.

Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (revision 280157)
+++ gcc/fortran/check.c (working copy)
@@ -1426,6 +1426,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 pointer at %L is not permitted as actual argument "
+                "of %qs intrinsic function", &x->where,
+                gfc_current_intrinsic);
+      return true;
+    }
+  return false;
+}

 bool
 gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
@@ -1433,13 +1445,10 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *tar
   symbol_attribute attr1, attr2;
   int i;
   bool t;
-  locus *where;

-  where = &pointer->where;
+  if (invalid_null_arg (pointer))
+    return false;

-  if (pointer->expr_type == EXPR_NULL)
-    goto null_arg;
-
   attr1 = gfc_expr_attr (pointer);

   if (!attr1.pointer && !attr1.proc_pointer)
@@ -1463,9 +1472,8 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *tar
   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);
@@ -1513,13 +1521,6 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *tar
          }
     }
   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;
-
 }


@@ -5124,6 +5125,9 @@ gfc_check_size (gfc_expr *array, gfc_expr *dim, gfc_ex
 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",
@@ -6139,6 +6143,9 @@ gfc_check_transfer (gfc_expr *source, gfc_expr *mold, 
   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)
@@ -6153,6 +6160,9 @@ gfc_check_transfer (gfc_expr *source, gfc_expr *mold, 
     return false;

   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.  */