Fortran: fix passing of NULL() to assumed-rank, derived type dummy [PR104819]

	PR fortran/104819

gcc/fortran/ChangeLog:

	* interface.cc (compare_parameter): For the rank check, NULL()
	inherits the rank of a provided MOLD argument.
	(gfc_compare_actual_formal): Adjust check of NULL() actual argument
	against formal to accept F2008 enhancements (allocatable dummy).
	NULL() with MOLD argument retains a pointer/allocatable attribute.
	* trans-expr.cc (conv_null_actual): Implement passing NULL() to
	derived-type dummy with pointer/allocatable attribute, and ensure
	that the actual rank is passed to an assumed-rank dummy.
	(gfc_conv_procedure_call): Use it.

gcc/testsuite/ChangeLog:

	* gfortran.dg/null_actual_7.f90: New test.

1 files changed, 48 insertions, 1 deletions

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 44a50c0..e3a4f59 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6398,7 +6398,7 @@ conv_dummy_value (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym,
 static void
 conv_null_actual (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym)
 {
-  gcc_assert (fsym && !fsym->attr.optional);
+  gcc_assert (fsym && e->expr_type == EXPR_NULL);
 
   /* Obtain the character length for a NULL() actual with a character
      MOLD argument.  Otherwise substitute a suitable dummy length.
@@ -6461,6 +6461,44 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym)
 	    }
 	}
     }
+  else if (fsym->ts.type == BT_DERIVED)
+    {
+      if (e->ts.type != BT_UNKNOWN)
+	/* MOLD is present.  Pass a corresponding temporary NULL pointer.
+	   For an assumed-rank dummy we provide a descriptor that passes
+	   the correct rank.  */
+	{
+	  tree rank;
+	  tree tmp = parmse->expr;
+
+	  tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, gfc_expr_attr (e));
+	  rank = gfc_conv_descriptor_rank (tmp);
+	  gfc_add_modify (&parmse->pre, rank,
+			  build_int_cst (TREE_TYPE (rank), e->rank));
+	  gfc_conv_descriptor_data_set (&parmse->pre, tmp, null_pointer_node);
+	  parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp);
+	}
+      else
+	/* MOLD is not present.  Use attributes from dummy argument, which is
+	   not allowed to be assumed-rank.  */
+	{
+	  int dummy_rank;
+	  tree tmp = parmse->expr;
+
+	  if (fsym->attr.allocatable && fsym->attr.intent == INTENT_UNKNOWN)
+	    fsym->attr.intent = INTENT_IN;
+	  tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, fsym->attr);
+	  dummy_rank = fsym->as ? fsym->as->rank : 0;
+	  if (dummy_rank > 0)
+	    {
+	      tree rank = gfc_conv_descriptor_rank (tmp);
+	      gfc_add_modify (&parmse->pre, rank,
+			      build_int_cst (TREE_TYPE (rank), dummy_rank));
+	    }
+	  gfc_conv_descriptor_data_set (&parmse->pre, tmp, null_pointer_node);
+	  parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp);
+	}
+    }
 }
 
 
@@ -6699,6 +6737,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		}
 	    }
 	}
+      else if (e->expr_type == EXPR_NULL
+	       && (e->ts.type == BT_UNKNOWN || e->ts.type == BT_DERIVED)
+	       && fsym && attr && (attr->pointer || attr->allocatable)
+	       && fsym->ts.type == BT_DERIVED)
+	{
+	  gfc_init_se (&parmse, NULL);
+	  gfc_conv_expr_reference (&parmse, e);
+	  conv_null_actual (&parmse, e, fsym);
+	}
       else if (arg->expr->expr_type == EXPR_NULL
 	       && fsym && !fsym->attr.pointer
 	       && (fsym->ts.type != BT_CLASS