diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2022-06-24 22:21:39 +0200 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2022-06-30 22:00:38 +0200 |
| commit | eb4336f546b2a770717af608c79b4d46f45ef7c2 (patch) | |
| tree | 94375094327ca6f0f89aced07c7f90e6647350eb /gcc | |
| parent | 5cf7ffe3be84d486a002b04c5664009ef5bc849d (diff) | |
| download | gcc-eb4336f546b2a770717af608c79b4d46f45ef7c2.zip gcc-eb4336f546b2a770717af608c79b4d46f45ef7c2.tar.gz gcc-eb4336f546b2a770717af608c79b4d46f45ef7c2.tar.bz2 | |
Fortran: fix checking of arguments to UNPACK when MASK is a variable [PR105813]
gcc/fortran/ChangeLog:
PR fortran/105813
* check.cc (gfc_check_unpack): Try to simplify MASK argument to
UNPACK so that checking of the VECTOR argument can work when MASK
is a variable.
gcc/testsuite/ChangeLog:
PR fortran/105813
* gfortran.dg/unpack_vector_1.f90: New test.
(cherry picked from commit f21f17f95c0237f4f987a5fa9f1fa9c7e0db3c40)
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/check.cc | 2 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/unpack_vector_1.f90 | 12 |
2 files changed, 14 insertions, 0 deletions
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index 0c2cb50..91d87a1 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -6353,6 +6353,8 @@ gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field) if (!same_type_check (vector, 0, field, 2)) return false; + gfc_simplify_expr (mask, 0); + if (mask->expr_type == EXPR_ARRAY && gfc_array_size (vector, &vector_size)) { diff --git a/gcc/testsuite/gfortran.dg/unpack_vector_1.f90 b/gcc/testsuite/gfortran.dg/unpack_vector_1.f90 new file mode 100644 index 0000000..5347c11 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unpack_vector_1.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } +! PR fortran/105813 +! Fix checking of VECTOR argument to UNPACK when MASK is a variable. +! Contributed by G.Steinmetz + +program p + logical, parameter :: mask(2,2) = reshape ([.true., .true., & + .false., .true.], & + shape (mask)) + print *, unpack ([1,2,3], mask, 0) ! OK + print *, unpack ([1,2], mask, 0) ! { dg-error "must provide at least" } +end |