Fortran: Fix gfc_conv_gfc_desc_to_cfi_desc with NULL [PR104126]

	PR fortran/104126
gcc/fortran/ChangeLog:

	* trans-expr.cc (gfc_conv_gfc_desc_to_cfi_desc): Handle NULL
	without MOLD.

gcc/testsuite/ChangeLog:

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

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 71d037101d4ec8b580e0012582f29c9eb13b4e6b..06713f24f953652ce332528aef24441b7c659da5 100644 (file)
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5610,8 +5610,11 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
     itype = (e->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR
             ? CFI_type_cfunptr : CFI_type_cptr);
   else
-    switch (e->ts.type)
-      {
+    {
+      if (e->expr_type == EXPR_NULL && e->ts.type == BT_UNKNOWN)
+       e->ts = fsym->ts;
+      switch (e->ts.type)
+       {
        case BT_INTEGER:
        case BT_LOGICAL:
        case BT_REAL:
@@ -5649,7 +5652,8 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
        case BT_UNKNOWN:
          // FIXME: Really unreachable? Or reachable for type(*) ? If so, CFI_type_other?
          gcc_unreachable ();
-      }
+       }
+    }
 
   tmp = gfc_get_cfi_desc_type (cfi);
   gfc_add_modify (&block, tmp,
@@ -5702,7 +5706,8 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
   gfc_init_block (&block2);
 
   /* Set elem_len, which may be only known at run time. */
-  if (e->ts.type == BT_CHARACTER)
+  if (e->ts.type == BT_CHARACTER
+      && (e->expr_type != EXPR_NULL || gfc_strlen != NULL_TREE))
     {
       gcc_assert (gfc_strlen);
       tmp = gfc_strlen;

diff --git a/gcc/testsuite/gfortran.dg/null_actual_2.f90 b/gcc/testsuite/gfortran.dg/null_actual_2.f90
new file mode 100644 (file)
index 0000000..de481f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/null_actual_2.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR fortran/104126
+!
+! Contributed by G. Steinmetz 
+!
+program p
+   use iso_c_binding, only: c_char
+   character(len=:,kind=c_char), pointer :: d
+   call s(null(d))
+   call s(null())
+contains
+   subroutine s(x) bind(c)
+      character(len=:, kind=c_char), pointer, intent(in) :: x
+   end
+end