procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR libfortran/38234 (In Reshape, SOURCE can be bigger than result)

Browse source 
2008-11-23  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/38234
	* intrinsics/reshape_generic.c (reshape_internal):
	Source can be larger than shape.
	* m4/reshape.m4:  Likewise.
	* generated/reshape_c10.c Regenerated.
	* generated/reshape_c16.c Regenerated.
	* generated/reshape_c4.c Regenerated.
	* generated/reshape_c8.c Regenerated.
	* generated/reshape_i16.c Regenerated.
	* generated/reshape_i4.c Regenerated.
	* generated/reshape_i8.c Regenerated.
	* generated/reshape_r10.c Regenerated.
	* generated/reshape_r16.c Regenerated.
	* generated/reshape_r4.c Regenerated.
	* generated/reshape_r8.c Regenerated.

2008-11-23  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/38234
	* gfortran.dg/reshape_4.f90:  New test.

From-SVN: r142137
This commit is contained in:
Thomas Koenig 2008-11-23 19:25:42 +00:00
parent 786a13d0d4
commit bd72cbc822
16 changed files with 454 additions and 416 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2008-11-23 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/38234
* gfortran.dg/reshape_4.f90: New test.
2008-11-22 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/38225

15
gcc/testsuite/gfortran.dg/reshape_4.f90 Normal file
View file

@ -0,0 +1,15 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
program main
real, dimension(2,2) :: result
real, dimension(6) :: source
real, dimension(2) :: pad
call random_number (source)
call random_number (pad)
result = reshape(source, shape(result),pad=pad(1:0))
result = reshape(source, shape(result))
result = reshape(source, shape(result),pad=pad)
end program main

18
libgfortran/ChangeLog
View file

@ -1,3 +1,21 @@
2008-11-23 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/38234
* intrinsics/reshape_generic.c (reshape_internal):
Source can be larger than shape.
* m4/reshape.m4: Likewise.
* generated/reshape_c10.c Regenerated.
* generated/reshape_c16.c Regenerated.
* generated/reshape_c4.c Regenerated.
* generated/reshape_c8.c Regenerated.
* generated/reshape_i16.c Regenerated.
* generated/reshape_i4.c Regenerated.
* generated/reshape_i8.c Regenerated.
* generated/reshape_r10.c Regenerated.
* generated/reshape_r16.c Regenerated.
* generated/reshape_r4.c Regenerated.
* generated/reshape_r8.c Regenerated.
2008-11-22 Danny Smith <dannysmith@users.sourceforge.net>
* libgfortran.h (__mingw_snprintf): Declare with gnu_printf

64
libgfortran/generated/reshape_c10.c
View file

@ -119,6 +119,37 @@ reshape_c10 (gfc_array_c10 * const restrict ret,
if (shape_empty)
return;
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (unlikely (compile_options.bounds_check))
{
index_type ret_extent, source_extent;
@ -144,7 +175,7 @@ reshape_c10 (gfc_array_c10 * const restrict ret,
source_extent *= se > 0 ? se : 0;
}
if (rs < source_extent || (rs > source_extent && !pad))
if (rs > source_extent && (!pad || pempty))
runtime_error("Incorrect size in SOURCE argument to RESHAPE"
" intrinsic: is %ld, should be %ld",
(long int) source_extent, (long int) rs);
@ -219,37 +250,6 @@ reshape_c10 (gfc_array_c10 * const restrict ret,
ssize = 0;
}
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (rsize != 0 && ssize != 0 && psize != 0)
{
rsize *= sizeof (GFC_COMPLEX_10);

64
libgfortran/generated/reshape_c16.c
View file

@ -119,6 +119,37 @@ reshape_c16 (gfc_array_c16 * const restrict ret,
if (shape_empty)
return;
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (unlikely (compile_options.bounds_check))
{
index_type ret_extent, source_extent;
@ -144,7 +175,7 @@ reshape_c16 (gfc_array_c16 * const restrict ret,
source_extent *= se > 0 ? se : 0;
}
if (rs < source_extent || (rs > source_extent && !pad))
if (rs > source_extent && (!pad || pempty))
runtime_error("Incorrect size in SOURCE argument to RESHAPE"
" intrinsic: is %ld, should be %ld",
(long int) source_extent, (long int) rs);
@ -219,37 +250,6 @@ reshape_c16 (gfc_array_c16 * const restrict ret,
ssize = 0;
}
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (rsize != 0 && ssize != 0 && psize != 0)
{
rsize *= sizeof (GFC_COMPLEX_16);

64
libgfortran/generated/reshape_c4.c
View file

@ -119,6 +119,37 @@ reshape_c4 (gfc_array_c4 * const restrict ret,
if (shape_empty)
return;
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (unlikely (compile_options.bounds_check))
{
index_type ret_extent, source_extent;
@ -144,7 +175,7 @@ reshape_c4 (gfc_array_c4 * const restrict ret,
source_extent *= se > 0 ? se : 0;
}
if (rs < source_extent || (rs > source_extent && !pad))
if (rs > source_extent && (!pad || pempty))
runtime_error("Incorrect size in SOURCE argument to RESHAPE"
" intrinsic: is %ld, should be %ld",
(long int) source_extent, (long int) rs);
@ -219,37 +250,6 @@ reshape_c4 (gfc_array_c4 * const restrict ret,
ssize = 0;
}
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (rsize != 0 && ssize != 0 && psize != 0)
{
rsize *= sizeof (GFC_COMPLEX_4);

64
libgfortran/generated/reshape_c8.c
View file

@ -119,6 +119,37 @@ reshape_c8 (gfc_array_c8 * const restrict ret,
if (shape_empty)
return;
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (unlikely (compile_options.bounds_check))
{
index_type ret_extent, source_extent;
@ -144,7 +175,7 @@ reshape_c8 (gfc_array_c8 * const restrict ret,
source_extent *= se > 0 ? se : 0;
}
if (rs < source_extent || (rs > source_extent && !pad))
if (rs > source_extent && (!pad || pempty))
runtime_error("Incorrect size in SOURCE argument to RESHAPE"
" intrinsic: is %ld, should be %ld",
(long int) source_extent, (long int) rs);
@ -219,37 +250,6 @@ reshape_c8 (gfc_array_c8 * const restrict ret,
ssize = 0;
}
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (rsize != 0 && ssize != 0 && psize != 0)
{
rsize *= sizeof (GFC_COMPLEX_8);

64
libgfortran/generated/reshape_i16.c
View file

@ -119,6 +119,37 @@ reshape_16 (gfc_array_i16 * const restrict ret,
if (shape_empty)
return;
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (unlikely (compile_options.bounds_check))
{
index_type ret_extent, source_extent;
@ -144,7 +175,7 @@ reshape_16 (gfc_array_i16 * const restrict ret,
source_extent *= se > 0 ? se : 0;
}
if (rs < source_extent || (rs > source_extent && !pad))
if (rs > source_extent && (!pad || pempty))
runtime_error("Incorrect size in SOURCE argument to RESHAPE"
" intrinsic: is %ld, should be %ld",
(long int) source_extent, (long int) rs);
@ -219,37 +250,6 @@ reshape_16 (gfc_array_i16 * const restrict ret,
ssize = 0;
}
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (rsize != 0 && ssize != 0 && psize != 0)
{
rsize *= sizeof (GFC_INTEGER_16);

64
libgfortran/generated/reshape_i4.c
View file

@ -119,6 +119,37 @@ reshape_4 (gfc_array_i4 * const restrict ret,
if (shape_empty)
return;
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (unlikely (compile_options.bounds_check))
{
index_type ret_extent, source_extent;
@ -144,7 +175,7 @@ reshape_4 (gfc_array_i4 * const restrict ret,
source_extent *= se > 0 ? se : 0;
}
if (rs < source_extent || (rs > source_extent && !pad))
if (rs > source_extent && (!pad || pempty))
runtime_error("Incorrect size in SOURCE argument to RESHAPE"
" intrinsic: is %ld, should be %ld",
(long int) source_extent, (long int) rs);
@ -219,37 +250,6 @@ reshape_4 (gfc_array_i4 * const restrict ret,
ssize = 0;
}
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (rsize != 0 && ssize != 0 && psize != 0)
{
rsize *= sizeof (GFC_INTEGER_4);

64
libgfortran/generated/reshape_i8.c
View file

@ -119,6 +119,37 @@ reshape_8 (gfc_array_i8 * const restrict ret,
if (shape_empty)
return;
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (unlikely (compile_options.bounds_check))
{
index_type ret_extent, source_extent;
@ -144,7 +175,7 @@ reshape_8 (gfc_array_i8 * const restrict ret,
source_extent *= se > 0 ? se : 0;
}
if (rs < source_extent || (rs > source_extent && !pad))
if (rs > source_extent && (!pad || pempty))
runtime_error("Incorrect size in SOURCE argument to RESHAPE"
" intrinsic: is %ld, should be %ld",
(long int) source_extent, (long int) rs);
@ -219,37 +250,6 @@ reshape_8 (gfc_array_i8 * const restrict ret,
ssize = 0;
}
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (rsize != 0 && ssize != 0 && psize != 0)
{
rsize *= sizeof (GFC_INTEGER_8);

64
libgfortran/generated/reshape_r10.c
View file

@ -119,6 +119,37 @@ reshape_r10 (gfc_array_r10 * const restrict ret,
if (shape_empty)
return;
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (unlikely (compile_options.bounds_check))
{
index_type ret_extent, source_extent;
@ -144,7 +175,7 @@ reshape_r10 (gfc_array_r10 * const restrict ret,
source_extent *= se > 0 ? se : 0;
}
if (rs < source_extent || (rs > source_extent && !pad))
if (rs > source_extent && (!pad || pempty))
runtime_error("Incorrect size in SOURCE argument to RESHAPE"
" intrinsic: is %ld, should be %ld",
(long int) source_extent, (long int) rs);
@ -219,37 +250,6 @@ reshape_r10 (gfc_array_r10 * const restrict ret,
ssize = 0;
}
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (rsize != 0 && ssize != 0 && psize != 0)
{
rsize *= sizeof (GFC_REAL_10);

64
libgfortran/generated/reshape_r16.c
View file

@ -119,6 +119,37 @@ reshape_r16 (gfc_array_r16 * const restrict ret,
if (shape_empty)
return;
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (unlikely (compile_options.bounds_check))
{
index_type ret_extent, source_extent;
@ -144,7 +175,7 @@ reshape_r16 (gfc_array_r16 * const restrict ret,
source_extent *= se > 0 ? se : 0;
}
if (rs < source_extent || (rs > source_extent && !pad))
if (rs > source_extent && (!pad || pempty))
runtime_error("Incorrect size in SOURCE argument to RESHAPE"
" intrinsic: is %ld, should be %ld",
(long int) source_extent, (long int) rs);
@ -219,37 +250,6 @@ reshape_r16 (gfc_array_r16 * const restrict ret,
ssize = 0;
}
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (rsize != 0 && ssize != 0 && psize != 0)
{
rsize *= sizeof (GFC_REAL_16);

64
libgfortran/generated/reshape_r4.c
View file

@ -119,6 +119,37 @@ reshape_r4 (gfc_array_r4 * const restrict ret,
if (shape_empty)
return;
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (unlikely (compile_options.bounds_check))
{
index_type ret_extent, source_extent;
@ -144,7 +175,7 @@ reshape_r4 (gfc_array_r4 * const restrict ret,
source_extent *= se > 0 ? se : 0;
}
if (rs < source_extent || (rs > source_extent && !pad))
if (rs > source_extent && (!pad || pempty))
runtime_error("Incorrect size in SOURCE argument to RESHAPE"
" intrinsic: is %ld, should be %ld",
(long int) source_extent, (long int) rs);
@ -219,37 +250,6 @@ reshape_r4 (gfc_array_r4 * const restrict ret,
ssize = 0;
}
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (rsize != 0 && ssize != 0 && psize != 0)
{
rsize *= sizeof (GFC_REAL_4);

64
libgfortran/generated/reshape_r8.c
View file

@ -119,6 +119,37 @@ reshape_r8 (gfc_array_r8 * const restrict ret,
if (shape_empty)
return;
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (unlikely (compile_options.bounds_check))
{
index_type ret_extent, source_extent;
@ -144,7 +175,7 @@ reshape_r8 (gfc_array_r8 * const restrict ret,
source_extent *= se > 0 ? se : 0;
}
if (rs < source_extent || (rs > source_extent && !pad))
if (rs > source_extent && (!pad || pempty))
runtime_error("Incorrect size in SOURCE argument to RESHAPE"
" intrinsic: is %ld, should be %ld",
(long int) source_extent, (long int) rs);
@ -219,37 +250,6 @@ reshape_r8 (gfc_array_r8 * const restrict ret,
ssize = 0;
}
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (rsize != 0 && ssize != 0 && psize != 0)
{
rsize *= sizeof (GFC_REAL_8);

64
libgfortran/intrinsics/reshape_generic.c
View file

@ -108,6 +108,37 @@ reshape_internal (parray *ret, parray *source, shape_type *shape,
if (shape_empty)
return;
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (unlikely (compile_options.bounds_check))
{
index_type ret_extent, source_extent;
@ -133,7 +164,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape,
source_extent *= se > 0 ? se : 0;
}
if (rs < source_extent || (rs > source_extent && !pad))
if (rs > source_extent && (!pad || pempty))
runtime_error("Incorrect size in SOURCE argument to RESHAPE"
" intrinsic: is %ld, should be %ld",
(long int) source_extent, (long int) rs);
@ -206,37 +237,6 @@ reshape_internal (parray *ret, parray *source, shape_type *shape,
ssize = 0;
}
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (rsize != 0 && ssize != 0 && psize != 0)
{
rsize *= size;

64
libgfortran/m4/reshape.m4
View file

@ -123,6 +123,37 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret,
if (shape_empty)
return;
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (unlikely (compile_options.bounds_check))
{
index_type ret_extent, source_extent;
@ -148,7 +179,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret,
source_extent *= se > 0 ? se : 0;
}
if (rs < source_extent || (rs > source_extent && !pad))
if (rs > source_extent && (!pad || pempty))
runtime_error("Incorrect size in SOURCE argument to RESHAPE"
" intrinsic: is %ld, should be %ld",
(long int) source_extent, (long int) rs);
@ -223,37 +254,6 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret,
ssize = 0;
}
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
psize = 1;
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
pstride[n] = pad->dim[n].stride;
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
if (pextent[n] <= 0)
{
pempty = 1;
pextent[n] = 0;
}
if (psize == pstride[n])
psize *= pextent[n];
else
psize = 0;
}
pptr = pad->data;
}
else
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
if (rsize != 0 && ssize != 0 && psize != 0)
{
rsize *= sizeof ('rtype_name`);