re PR fortran/89492 (Endless compilation of an invalid TRANSFER after r269177)

2019-02-26  Harald Anlauf  <anlauf@gmx.de>

	PR fortran/89492
	* check.c (gfc_calculate_transfer_sizes): Handle cases where
	storage size of elements of MOLD is 0.

	PR fortran/89492
	* gfortran.dg/pr89492.f90: New test.

From-SVN: r269227

gcc/fortran/ChangeLog

+2019-02-26  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/89492
+	* check.c (gfc_calculate_transfer_sizes): Handle cases where
+	storage size of elements of MOLD is 0.
+
 2019-02-26  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/89496

gcc/fortran/check.c

@@ -5487,6 +5487,26 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size,
   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)
     {

gcc/testsuite/ChangeLog

+2019-02-26  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/89492
+	* gfortran.dg/pr89492.f90: New test.
+
 2019-02-26  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/89496

gcc/testsuite/gfortran.dg/pr89492.f90

+! { 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 :: i = len (transfer('',['']))  ! i = 0
+  integer, parameter :: l = len (transfer('', '' ))  ! l = 0
+  integer, parameter :: m(k) = k
+  integer, parameter :: j(i) = i
+  integer, parameter :: n(l) = l
+  print *, k,i,l,m,j,n
+  print *,      transfer(1,[''])                ! { dg-error "shall not have storage size 0" }
+  print *,      transfer(1, '' )                ! { dg-error "shall not have storage size 0" }
+  print *, size(transfer(1,['']))               ! { dg-error "shall not have storage size 0" }
+  print *, len (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