re PR fortran/35990 (run-time abort for PACK of run-time zero sized array)

2008-05-04  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/35990
	* intrinsics/pack_generic.c:  If an extent of the source
	array is less then zero, set it to zero.  Set the source
	pointer to NULL if the source size is zero.  Set the total
	number of elements to zero if the vector has an extent
	less or equal to zero.
	* m4/pack.m4:  Set the source pointer to NULL if the
	source array is zero-sized.  Set the total number of
	elemements to zero if the vector has an extent less or
	equal to zero.
	* generated/pack_i1.c:  Regenerated.
	* generated/pack_i2.c:  Regenerated.
	* generated/pack_i4.c:  Regenerated.
	* generated/pack_i8.c:  Regenerated.
	* generated/pack_i16.c:  Regenerated.
	* generated/pack_r4.c:  Regenerated.
	* generated/pack_r8.c:  Regenerated.
	* generated/pack_r10.c:  Regenerated.
	* generated/pack_r16.c:  Regenerated.
	* generated/pack_c4.c:  Regenerated.
	* generated/pack_c8.c:  Regenerated.
	* generated/pack_c10.c:  Regenerated.
	* generated/pack_c16.c:  Regenerated.

2008-05-04  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/35990
	* gfortran.dg/intrinsic_pack_4.f90:  New test case.

From-SVN: r134927
This commit is contained in:
Thomas Koenig 2008-05-04 08:06:02 +00:00
parent 3e438e2b76
commit 7ad99d60f4
17 changed files with 257 additions and 15 deletions

View File

@ -1,3 +1,8 @@
2008-05-04 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/35990
* gfortran.dg/intrinsic_pack_4.f90: New test case.
2008-05-03 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/discr6_pkg.ads: New helper.

View File

@ -0,0 +1,72 @@
! { dg-do run }
! PR 35990 - some empty array sections caused pack to crash.
! Test case contributed by Dick Hendrickson, adjusted and
! extended by Thomas Koenig.
program try_gf1048
call gf1048a( 10, 8, 7, 1, 0, .true.)
call gf1048b( 10, 8, 7, 1, 0, .true.)
call gf1048c( 10, 8, 7, 1, 0, .true.)
call gf1048d( 10, 8, 7, 1, 0, .true.)
call P_inta ( 10, 8, 7, 1, 0, .true.)
call P_intb ( 10, 8, 7, 1, 0, .true.)
call P_intc ( 10, 8, 7, 1, 0, .true.)
call P_intd ( 10, 8, 7, 1, 0, .true.)
end program
SUBROUTINE GF1048a(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
CHARACTER(9) BDA(10)
CHARACTER(9) BDA1(10)
BDA( 8:7) = PACK(BDA1( 10: 1), NF_TRUE)
END SUBROUTINE
SUBROUTINE GF1048b(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
CHARACTER(9) BDA(10)
CHARACTER(9) BDA1(nf10)
BDA(NF8:NF7) = PACK(BDA1(NF8:NF7), NF_TRUE)
END SUBROUTINE
SUBROUTINE GF1048c(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
CHARACTER(9) BDA(10)
CHARACTER(9) BDA1(10)
BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
END SUBROUTINE
SUBROUTINE GF1048d(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
CHARACTER(9) BDA(10)
CHARACTER(9) BDA1(nf10)
BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
END SUBROUTINE
SUBROUTINE P_INTa(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
INTEGER BDA(10)
INTEGER BDA1(10)
BDA( 8:7) = PACK(BDA1( 10: 1), NF_TRUE)
END SUBROUTINE
SUBROUTINE P_INTb(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
INTEGER BDA(10)
INTEGER BDA1(nf10)
BDA(NF8:NF7) = PACK(BDA1(NF8:NF7), NF_TRUE)
END SUBROUTINE
SUBROUTINE P_INTc(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
INTEGER BDA(10)
INTEGER BDA1(10)
BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
END SUBROUTINE
SUBROUTINE P_INTd(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
INTEGER BDA(10)
INTEGER BDA1(nf10)
BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
END SUBROUTINE

View File

@ -1,3 +1,29 @@
2008-05-04 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/35990
* intrinsics/pack_generic.c: If an extent of the source
array is less then zero, set it to zero. Set the source
pointer to NULL if the source size is zero. Set the total
number of elements to zero if the vector has an extent
less or equal to zero.
* m4/pack.m4: Set the source pointer to NULL if the
source array is zero-sized. Set the total number of
elemements to zero if the vector has an extent less or
equal to zero.
* generated/pack_i1.c: Regenerated.
* generated/pack_i2.c: Regenerated.
* generated/pack_i4.c: Regenerated.
* generated/pack_i8.c: Regenerated.
* generated/pack_i16.c: Regenerated.
* generated/pack_r4.c: Regenerated.
* generated/pack_r8.c: Regenerated.
* generated/pack_r10.c: Regenerated.
* generated/pack_r16.c: Regenerated.
* generated/pack_c4.c: Regenerated.
* generated/pack_c8.c: Regenerated.
* generated/pack_c10.c: Regenerated.
* generated/pack_c16.c: Regenerated.
2008-05-01 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/36094

View File

@ -103,7 +103,6 @@ pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array,
dim = GFC_DESCRIPTOR_RANK (array);
sptr = array->data;
mptr = mask->data;
/* Use the same loop for all logical types, by using GFC_LOGICAL_1
@ -139,6 +138,11 @@ pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array,
if (mstride[0] == 0)
mstride[0] = mask_kind;
if (zero_sized)
sptr = NULL;
else
sptr = array->data;
if (ret->data == NULL || compile_options.bounds_check)
{
/* Count the elements, either for allocating memory or
@ -149,6 +153,11 @@ pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array,
/* The return array will have as many
elements as there are in VECTOR. */
total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
if (total < 0)
{
total = 0;
vector = NULL;
}
}
else
{
@ -308,3 +317,4 @@ pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array,
}
#endif

View File

@ -103,7 +103,6 @@ pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array,
dim = GFC_DESCRIPTOR_RANK (array);
sptr = array->data;
mptr = mask->data;
/* Use the same loop for all logical types, by using GFC_LOGICAL_1
@ -139,6 +138,11 @@ pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array,
if (mstride[0] == 0)
mstride[0] = mask_kind;
if (zero_sized)
sptr = NULL;
else
sptr = array->data;
if (ret->data == NULL || compile_options.bounds_check)
{
/* Count the elements, either for allocating memory or
@ -149,6 +153,11 @@ pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array,
/* The return array will have as many
elements as there are in VECTOR. */
total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
if (total < 0)
{
total = 0;
vector = NULL;
}
}
else
{
@ -308,3 +317,4 @@ pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array,
}
#endif

View File

@ -103,7 +103,6 @@ pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array,
dim = GFC_DESCRIPTOR_RANK (array);
sptr = array->data;
mptr = mask->data;
/* Use the same loop for all logical types, by using GFC_LOGICAL_1
@ -139,6 +138,11 @@ pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array,
if (mstride[0] == 0)
mstride[0] = mask_kind;
if (zero_sized)
sptr = NULL;
else
sptr = array->data;
if (ret->data == NULL || compile_options.bounds_check)
{
/* Count the elements, either for allocating memory or
@ -149,6 +153,11 @@ pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array,
/* The return array will have as many
elements as there are in VECTOR. */
total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
if (total < 0)
{
total = 0;
vector = NULL;
}
}
else
{
@ -308,3 +317,4 @@ pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array,
}
#endif

View File

@ -103,7 +103,6 @@ pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array,
dim = GFC_DESCRIPTOR_RANK (array);
sptr = array->data;
mptr = mask->data;
/* Use the same loop for all logical types, by using GFC_LOGICAL_1
@ -139,6 +138,11 @@ pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array,
if (mstride[0] == 0)
mstride[0] = mask_kind;
if (zero_sized)
sptr = NULL;
else
sptr = array->data;
if (ret->data == NULL || compile_options.bounds_check)
{
/* Count the elements, either for allocating memory or
@ -149,6 +153,11 @@ pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array,
/* The return array will have as many
elements as there are in VECTOR. */
total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
if (total < 0)
{
total = 0;
vector = NULL;
}
}
else
{
@ -308,3 +317,4 @@ pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array,
}
#endif

View File

@ -103,7 +103,6 @@ pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array,
dim = GFC_DESCRIPTOR_RANK (array);
sptr = array->data;
mptr = mask->data;
/* Use the same loop for all logical types, by using GFC_LOGICAL_1
@ -139,6 +138,11 @@ pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array,
if (mstride[0] == 0)
mstride[0] = mask_kind;
if (zero_sized)
sptr = NULL;
else
sptr = array->data;
if (ret->data == NULL || compile_options.bounds_check)
{
/* Count the elements, either for allocating memory or
@ -149,6 +153,11 @@ pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array,
/* The return array will have as many
elements as there are in VECTOR. */
total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
if (total < 0)
{
total = 0;
vector = NULL;
}
}
else
{
@ -308,3 +317,4 @@ pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array,
}
#endif

View File

@ -103,7 +103,6 @@ pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array,
dim = GFC_DESCRIPTOR_RANK (array);
sptr = array->data;
mptr = mask->data;
/* Use the same loop for all logical types, by using GFC_LOGICAL_1
@ -139,6 +138,11 @@ pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array,
if (mstride[0] == 0)
mstride[0] = mask_kind;
if (zero_sized)
sptr = NULL;
else
sptr = array->data;
if (ret->data == NULL || compile_options.bounds_check)
{
/* Count the elements, either for allocating memory or
@ -149,6 +153,11 @@ pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array,
/* The return array will have as many
elements as there are in VECTOR. */
total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
if (total < 0)
{
total = 0;
vector = NULL;
}
}
else
{
@ -308,3 +317,4 @@ pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array,
}
#endif

View File

@ -103,7 +103,6 @@ pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array,
dim = GFC_DESCRIPTOR_RANK (array);
sptr = array->data;
mptr = mask->data;
/* Use the same loop for all logical types, by using GFC_LOGICAL_1
@ -139,6 +138,11 @@ pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array,
if (mstride[0] == 0)
mstride[0] = mask_kind;
if (zero_sized)
sptr = NULL;
else
sptr = array->data;
if (ret->data == NULL || compile_options.bounds_check)
{
/* Count the elements, either for allocating memory or
@ -149,6 +153,11 @@ pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array,
/* The return array will have as many
elements as there are in VECTOR. */
total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
if (total < 0)
{
total = 0;
vector = NULL;
}
}
else
{
@ -308,3 +317,4 @@ pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array,
}
#endif

View File

@ -103,7 +103,6 @@ pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array,
dim = GFC_DESCRIPTOR_RANK (array);
sptr = array->data;
mptr = mask->data;
/* Use the same loop for all logical types, by using GFC_LOGICAL_1
@ -139,6 +138,11 @@ pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array,
if (mstride[0] == 0)
mstride[0] = mask_kind;
if (zero_sized)
sptr = NULL;
else
sptr = array->data;
if (ret->data == NULL || compile_options.bounds_check)
{
/* Count the elements, either for allocating memory or
@ -149,6 +153,11 @@ pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array,
/* The return array will have as many
elements as there are in VECTOR. */
total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
if (total < 0)
{
total = 0;
vector = NULL;
}
}
else
{
@ -308,3 +317,4 @@ pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array,
}
#endif

View File

@ -103,7 +103,6 @@ pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array,
dim = GFC_DESCRIPTOR_RANK (array);
sptr = array->data;
mptr = mask->data;
/* Use the same loop for all logical types, by using GFC_LOGICAL_1
@ -139,6 +138,11 @@ pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array,
if (mstride[0] == 0)
mstride[0] = mask_kind;
if (zero_sized)
sptr = NULL;
else
sptr = array->data;
if (ret->data == NULL || compile_options.bounds_check)
{
/* Count the elements, either for allocating memory or
@ -149,6 +153,11 @@ pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array,
/* The return array will have as many
elements as there are in VECTOR. */
total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
if (total < 0)
{
total = 0;
vector = NULL;
}
}
else
{
@ -308,3 +317,4 @@ pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array,
}
#endif

View File

@ -103,7 +103,6 @@ pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array,
dim = GFC_DESCRIPTOR_RANK (array);
sptr = array->data;
mptr = mask->data;
/* Use the same loop for all logical types, by using GFC_LOGICAL_1
@ -139,6 +138,11 @@ pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array,
if (mstride[0] == 0)
mstride[0] = mask_kind;
if (zero_sized)
sptr = NULL;
else
sptr = array->data;
if (ret->data == NULL || compile_options.bounds_check)
{
/* Count the elements, either for allocating memory or
@ -149,6 +153,11 @@ pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array,
/* The return array will have as many
elements as there are in VECTOR. */
total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
if (total < 0)
{
total = 0;
vector = NULL;
}
}
else
{
@ -308,3 +317,4 @@ pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array,
}
#endif

View File

@ -103,7 +103,6 @@ pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array,
dim = GFC_DESCRIPTOR_RANK (array);
sptr = array->data;
mptr = mask->data;
/* Use the same loop for all logical types, by using GFC_LOGICAL_1
@ -139,6 +138,11 @@ pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array,
if (mstride[0] == 0)
mstride[0] = mask_kind;
if (zero_sized)
sptr = NULL;
else
sptr = array->data;
if (ret->data == NULL || compile_options.bounds_check)
{
/* Count the elements, either for allocating memory or
@ -149,6 +153,11 @@ pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array,
/* The return array will have as many
elements as there are in VECTOR. */
total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
if (total < 0)
{
total = 0;
vector = NULL;
}
}
else
{
@ -308,3 +317,4 @@ pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array,
}
#endif

View File

@ -103,7 +103,6 @@ pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array,
dim = GFC_DESCRIPTOR_RANK (array);
sptr = array->data;
mptr = mask->data;
/* Use the same loop for all logical types, by using GFC_LOGICAL_1
@ -139,6 +138,11 @@ pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array,
if (mstride[0] == 0)
mstride[0] = mask_kind;
if (zero_sized)
sptr = NULL;
else
sptr = array->data;
if (ret->data == NULL || compile_options.bounds_check)
{
/* Count the elements, either for allocating memory or
@ -149,6 +153,11 @@ pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array,
/* The return array will have as many
elements as there are in VECTOR. */
total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
if (total < 0)
{
total = 0;
vector = NULL;
}
}
else
{
@ -308,3 +317,4 @@ pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array,
}
#endif

View File

@ -103,7 +103,6 @@ pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array,
dim = GFC_DESCRIPTOR_RANK (array);
sptr = array->data;
mptr = mask->data;
/* Use the same loop for all logical types, by using GFC_LOGICAL_1
@ -139,6 +138,11 @@ pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array,
if (mstride[0] == 0)
mstride[0] = mask_kind;
if (zero_sized)
sptr = NULL;
else
sptr = array->data;
if (ret->data == NULL || compile_options.bounds_check)
{
/* Count the elements, either for allocating memory or
@ -149,6 +153,11 @@ pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array,
/* The return array will have as many
elements as there are in VECTOR. */
total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
if (total < 0)
{
total = 0;
vector = NULL;
}
}
else
{
@ -308,3 +317,4 @@ pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array,
}
#endif

View File

@ -104,7 +104,6 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array,
dim = GFC_DESCRIPTOR_RANK (array);
sptr = array->data;
mptr = mask->data;
/* Use the same loop for all logical types, by using GFC_LOGICAL_1
@ -140,6 +139,11 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array,
if (mstride[0] == 0)
mstride[0] = mask_kind;
if (zero_sized)
sptr = NULL;
else
sptr = array->data;
if (ret->data == NULL || compile_options.bounds_check)
{
/* Count the elements, either for allocating memory or
@ -150,6 +154,11 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array,
/* The return array will have as many
elements as there are in VECTOR. */
total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
if (total < 0)
{
total = 0;
vector = NULL;
}
}
else
{
@ -309,4 +318,4 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array,
}
#endif
'
'