From: Harald Anlauf <anlauf@gmx.de>
Date: Tue, 26 Feb 2019 20:03:08 +0000 (+0000)
Subject: re PR fortran/89492 (Endless compilation of an invalid TRANSFER after r269177)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=ec2d749a10606629e257ff6e7a7435289c9068d8;p=gcc.git

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
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2646608faae..85ce5bce560 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 0367c92ed4b..c5f6ae300a7 100644
--- a/gcc/fortran/check.c
+++ b/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)
     {
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2f700d73bba..c041ed6c090 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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
diff --git a/gcc/testsuite/gfortran.dg/pr89492.f90 b/gcc/testsuite/gfortran.dg/pr89492.f90
new file mode 100644
index 00000000000..1a21f4a7c91
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr89492.f90
@@ -0,0 +1,27 @@
+! { 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