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

--- Comment #3 from kargl at gcc dot gnu.org ---
Updated patch to deal with comments #1.

Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c     (revision 280157)
+++ gcc/fortran/intrinsic.c     (working copy)
@@ -4428,6 +4428,19 @@ check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_
          return false;
        }

+      /* F2018, p. 328: An argument to an intrinsic procedure other than
+        ASSOCIATED, NULL, or PRESENT shall be a data object.  A EXPR_NULL
+        is not a data object.  */
+      if (actual->expr->expr_type == EXPR_NULL
+         && !(strcmp(gfc_current_intrinsic, "associated") == 0
+               || strcmp(gfc_current_intrinsic, "null") == 0
+               || strcmp(gfc_current_intrinsic, "present") == 0))
+       {
+         gfc_error ("NULL() at %L cannot appear as an actual argument in %qs",
+                    &actual->expr->where, gfc_current_intrinsic);
+         return false;
+       }
+
       /* If the formal argument is INTENT([IN]OUT), check for definability. 
*/
       if (formal->intent == INTENT_INOUT || formal->intent == INTENT_OUT)
        {
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (revision 280157)
+++ gcc/fortran/check.c (working copy)
@@ -3444,8 +3444,16 @@ gfc_check_len_lentrim (gfc_expr *s, gfc_expr *kind)
   if (!type_check (s, 0, BT_CHARACTER))
     return false;

+  if (s->expr_type == EXPR_NULL)
+    {
+      gfc_error ("Intrinsic function NULL at %L cannot be an actual "
+                "argument to %qs", &s->where, gfc_current_intrinsic);
+      return false;
+    }
+
   if (!kind_check (kind, 1, BT_INTEGER))
     return false;
+
   if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic "
                               "with KIND argument at %L",
                               gfc_current_intrinsic, &kind->where))
@@ -6377,6 +6385,13 @@ gfc_check_trim (gfc_expr *x)
 {
   if (!type_check (x, 0, BT_CHARACTER))
     return false;
+
+  if (x->expr_type == EXPR_NULL)
+    {
+      gfc_error ("Intrinsic function NULL at %L cannot be an actual "
+                "argument to %qs", &x->where, gfc_current_intrinsic);
+      return false;
+    }

   if (!scalar_check (x, 0))
     return false;

Reply via email to