diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2022-01-25 21:56:39 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2022-01-25 21:56:39 +0100 |
| commit | ec543c9833c2d9283c035cd8430849eb4ec04406 (patch) | |
| tree | 29c2e6f32f9b3bca33ee7cedba7bdfe7d6058a24 | |
| parent | 34e8dafb76240f69c729c11cfc8c8fc4f717bc17 (diff) | |
| download | gcc-ec543c9833c2d9283c035cd8430849eb4ec04406.zip gcc-ec543c9833c2d9283c035cd8430849eb4ec04406.tar.gz gcc-ec543c9833c2d9283c035cd8430849eb4ec04406.tar.bz2 | |
Fortran: MOLD argument to TRANSFER intrinsic having storage size zero
gcc/fortran/ChangeLog:
PR fortran/104227
* check.cc (gfc_calculate_transfer_sizes): Fix checking of arrays
passed as MOLD argument to the TRANSFER intrinsic for having
storage size zero.
gcc/testsuite/ChangeLog:
PR fortran/104227
* gfortran.dg/transfer_check_6.f90: New test.
| -rw-r--r-- | gcc/fortran/check.cc | 2 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/transfer_check_6.f90 | 11 |
2 files changed, 12 insertions, 1 deletions
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index 4fa05ee..d6c6767 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -6151,7 +6151,7 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size, * If SIZE is present, the result is an array of rank one and size SIZE. */ if (result_elt_size == 0 && *source_size > 0 && !size - && mold->expr_type == EXPR_ARRAY) + && (mold->expr_type == EXPR_ARRAY || mold->rank)) { gfc_error ("%<MOLD%> argument of %<TRANSFER%> intrinsic at %L is an " "array and shall not have storage size 0 when %<SOURCE%> " diff --git a/gcc/testsuite/gfortran.dg/transfer_check_6.f90 b/gcc/testsuite/gfortran.dg/transfer_check_6.f90 new file mode 100644 index 0000000..dffd091 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/transfer_check_6.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +! PR fortran/104227 - ICE virtual memory exhausted +! Contributed by G.Steinmetz + +program p + type t + end type + type(t) :: x(2) + print *, transfer(1, x) ! { dg-error "shall not have storage size 0" } + x = transfer(1, x) ! { dg-error "shall not have storage size 0" } +end |