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

--- Comment #3 from Harald Anlauf <anlauf at gmx dot de> ---
I found another issue for uses of transfer('',['']), so here's an updated
version with a clearer error message:

Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (revision 269177)
+++ gcc/fortran/check.c (working copy)
@@ -5487,6 +5487,26 @@
   if (!gfc_element_size (mold, &result_elt_size))
     return false;

+  if (result_elt_size == 0 && *source_size > 0)
+    {
+      gfc_error ("%<MOLD%> argument of %<TRANSFER%> intrinsic at %L "
+                 "shall not have storage size 0 when %<SOURCE%> "
+                "argument has size greater than 0", &mold->where);
+      return false;
+    }
+
+  /* If MOLD is a scalar and SIZE is absent, the result is a scalar.
+   * If MOLD is an array and SIZE is absent, the result is an array and of
+   * rank one. Its size is as small as possible such that its physical
+   * representation is not shorter than that of SOURCE.
+   */
+  if (result_elt_size == 0 && *source_size == 0 && !size)
+    {
+      *result_size = 0;
+      *result_length_p = 0;
+      return true;
+    }
+
   if ((result_elt_size > 0 && (mold->expr_type == EXPR_ARRAY || mold->rank))
       || size)
     {

Suggested testcase:

! { dg-do compile }
!
! PR fortran/89492 - Endless compilation of an invalid TRANSFER after r269177 
! Test error recovery for invalid uses of TRANSFER
! Test proper simplification for MOLD with size 0
!
! Derived from original testcase by Dominique d'Humieres

program bug4a
  implicit none
  type bug4
! Intentionally left empty
  end type bug4
  integer, parameter :: k = size(transfer('',['']))  ! k = 0
  integer, parameter :: m(k) = k
  print *,      transfer(1,[''])                ! { dg-error "shall not have
storage size 0" }
  print *, size(transfer(1,['']))               ! { dg-error "shall not have
storage size 0" }
  print *, size(transfer([1],[bug4()]))         ! { dg-error "shall not have
storage size 0" }
  print *, transfer(transfer([1],[bug4()]),[1]) ! { dg-error "shall not have
storage size 0" }
end program bug4a

Reply via email to