[gcc r11-9539] Fortran: reject simplifying TRANSFER for MOLD with storage size 0
Harald Anlauf
anlauf@gcc.gnu.org
Fri Feb 4 19:15:06 GMT 2022
https://gcc.gnu.org/g:7a0fab4bddce549380b2713a910127332a091e19
commit r11-9539-g7a0fab4bddce549380b2713a910127332a091e19
Author: Harald Anlauf <anlauf@gmx.de>
Date: Tue Feb 1 23:33:24 2022 +0100
Fortran: reject simplifying TRANSFER for MOLD with storage size 0
gcc/fortran/ChangeLog:
PR fortran/104311
* check.c (gfc_calculate_transfer_sizes): Checks for case when
storage size of SOURCE is greater than zero while the storage size
of MOLD is zero and MOLD is an array shall not depend on SIZE.
gcc/testsuite/ChangeLog:
PR fortran/104311
* gfortran.dg/transfer_simplify_15.f90: New test.
(cherry picked from commit 4e4252db0348a7274663a892c3a96d3ed7702aff)
Diff:
---
gcc/fortran/check.c | 2 +-
gcc/testsuite/gfortran.dg/transfer_simplify_15.f90 | 11 +++++++++++
2 files changed, 12 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 6cc64910c84..1add9436dce 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -6139,7 +6139,7 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size,
* representation is not shorter than that of SOURCE.
* If SIZE is present, the result is an array of rank one and size SIZE.
*/
- if (result_elt_size == 0 && *source_size > 0 && !size
+ if (result_elt_size == 0 && *source_size > 0
&& (mold->expr_type == EXPR_ARRAY || mold->rank))
{
gfc_error ("%<MOLD%> argument of %<TRANSFER%> intrinsic at %L is an "
diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_15.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_15.f90
new file mode 100644
index 00000000000..cdbec97ae71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_simplify_15.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR fortran/104311 - ICE out of memory
+! Contributed by G.Steinmetz
+
+program p
+ type t
+ end type
+ type(t) :: x(2)
+ print *, transfer(1,x,2) ! { dg-error "shall not have storage size 0" }
+ print *, transfer(1,x,huge(1)) ! { dg-error "shall not have storage size 0" }
+end
More information about the Gcc-cvs
mailing list