diff options
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/intrinsic_pack_5.f90 | 16 | ||||
| -rw-r--r-- | libgfortran/ChangeLog | 7 | ||||
| -rw-r--r-- | libgfortran/intrinsics/pack_generic.c | 8 |
4 files changed, 33 insertions, 4 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 12a57bc..7ce1947 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2009-12-06 Janus Weil <janus@gcc.gnu.org> + + PR fortran/41478 + PR fortran/42268 + * gfortran.dg/intrinsic_pack_5.f90: New test. + 2009-12-04 Jason Merrill <jason@redhat.com> PR c++/42010 diff --git a/gcc/testsuite/gfortran.dg/intrinsic_pack_5.f90 b/gcc/testsuite/gfortran.dg/intrinsic_pack_5.f90 new file mode 100644 index 0000000..c0540b6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/intrinsic_pack_5.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! +! PR 41478: Corrupted memory using PACK for derived-types with allocated components +! PR 42268: [4.4/4.5 Regression] derived type segfault with pack +! +! Original test case by Juergen Reuter <reuter@physik.uni-freiburg.de> +! Modified by Janus Weil <janus@gcc.gnu.org> + +type :: container_t + integer:: entry = -1 +end type container_t +type(container_t), dimension(1) :: a1, a2 +a2(1)%entry = 1 +a1 = pack (a2, mask = [.true.]) +if (a1(1)%entry/=1) call abort() +end diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 7f69a16..3c63896 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2009-12-06 Janus Weil <janus@gcc.gnu.org> + + PR fortran/41478 + PR fortran/42268 + * intrinsics/pack_generic.c (pack): Add safety checks for the case that + 'vector' is NULL. + 2009-12-05 Ralf Wildenhues <Ralf.Wildenhues@gmx.de> * Makefile.in: Regenerate. diff --git a/libgfortran/intrinsics/pack_generic.c b/libgfortran/intrinsics/pack_generic.c index 2e24105..ee6a483 100644 --- a/libgfortran/intrinsics/pack_generic.c +++ b/libgfortran/intrinsics/pack_generic.c @@ -346,7 +346,7 @@ pack (gfc_array_char *ret, const gfc_array_char *array, case GFC_DTYPE_DERIVED_2: if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(array->data) - || GFC_UNALIGNED_2(vector->data)) + || (vector && GFC_UNALIGNED_2(vector->data))) break; else { @@ -357,7 +357,7 @@ pack (gfc_array_char *ret, const gfc_array_char *array, case GFC_DTYPE_DERIVED_4: if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(array->data) - || GFC_UNALIGNED_4(vector->data)) + || (vector && GFC_UNALIGNED_4(vector->data))) break; else { @@ -368,7 +368,7 @@ pack (gfc_array_char *ret, const gfc_array_char *array, case GFC_DTYPE_DERIVED_8: if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(array->data) - || GFC_UNALIGNED_8(vector->data)) + || (vector && GFC_UNALIGNED_8(vector->data))) break; else { @@ -379,7 +379,7 @@ pack (gfc_array_char *ret, const gfc_array_char *array, #ifdef HAVE_GFC_INTEGER_16 case GFC_DTYPE_DERIVED_16: if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(array->data) - || GFC_UNALIGNED_16(vector->data)) + || (vector && GFC_UNALIGNED_16(vector->data))) break; else { |