From a15b72fa7f318ab4e2bbdaddc0735b1f2185ddd0 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Sun, 6 Dec 2009 23:57:13 +0100 Subject: re PR fortran/41478 (Corrupted memory using PACK for derived-types with allocated components) libgfortran/ 2009-12-06 Janus Weil PR fortran/41478 PR fortran/42268 * intrinsics/pack_generic.c (pack): Add safety checks for the case that 'vector' is NULL. gcc/testsuite/ 2009-12-06 Janus Weil PR fortran/41478 PR fortran/42268 * gfortran.dg/intrinsic_pack_5.f90: New test. From-SVN: r155024 --- gcc/testsuite/ChangeLog | 6 ++++++ gcc/testsuite/gfortran.dg/intrinsic_pack_5.f90 | 16 ++++++++++++++++ libgfortran/ChangeLog | 7 +++++++ libgfortran/intrinsics/pack_generic.c | 8 ++++---- 4 files changed, 33 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/intrinsic_pack_5.f90 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 + + PR fortran/41478 + PR fortran/42268 + * gfortran.dg/intrinsic_pack_5.f90: New test. + 2009-12-04 Jason Merrill 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 +! Modified by Janus Weil + +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 + + 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 * 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 { -- cgit v1.1