+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
--- /dev/null
+! { 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
+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
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;
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);
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);
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;
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);
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);
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;
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);
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);
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;
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);
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);
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;
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);
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);
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;
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);
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);
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;
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);
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);
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;
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);
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);
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;
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);
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);
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;
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);
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);
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;
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);
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);
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;
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);
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;
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;
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);
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`);