From 1b1197a3a32c4ab335b02c03543e21dd0f9558c6 Mon Sep 17 00:00:00 2001 From: tkoenig Date: Wed, 18 May 2005 20:24:32 +0000 Subject: [PATCH] 2005-05-18 Thomas Koenig PR libfortran/21127 * Makefile.am: Add generated/reshape_c4.c and generated/reshape_c8.c. * Makefile.in: Regenerated. * m4/iparm.m4: Define rtype_ccode to be c4 or c8 for complex types, 4 or 8 otherwise. * m4/reshape.m4: Use rtype_ccode instead of rtype_kind in function name. * generated/reshape_c4.c: New file. * generated/reshape_c8.c: New file. 2005-05-18 Thomas Koenig PR libfortran/21127 * fortran/iresolve.c (gfc_resolve_reshape): Add gfc_type_letter (BT_COMPLEX) for complex to to resolved function name. 2005-05-18 Thomas Koenig PR libfortran/21127 * gfortran.dg/reshape-complex.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@99925 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 +++++ gcc/fortran/iresolve.c | 10 +++++-- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/reshape-complex.f90 | 11 ++++++++ libgfortran/ChangeLog | 13 +++++++++ .../{m4/reshape.m4 => generated/reshape_c4.c} | 32 ++++++++++------------ .../{m4/reshape.m4 => generated/reshape_c8.c} | 32 ++++++++++------------ libgfortran/m4/iparm.m4 | 1 + libgfortran/m4/reshape.m4 | 6 ++-- 9 files changed, 78 insertions(+), 39 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/reshape-complex.f90 copy libgfortran/{m4/reshape.m4 => generated/reshape_c4.c} (91%) copy libgfortran/{m4/reshape.m4 => generated/reshape_c8.c} (91%) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 31179f06a02..87e10472d98 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2005-05-18 Thomas Koenig + + PR libfortran/21127 + * fortran/iresolve.c (gfc_resolve_reshape): Add + gfc_type_letter (BT_COMPLEX) for complex to + to resolved function name. + 2005-05-18 Erik Edelmann * array.c (gfc_match_array_constructor): Support [ ... ] diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 746b97df444..e9392871fef 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -1137,8 +1137,14 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape, case 4: case 8: /* case 16: */ - f->value.function.name = - gfc_get_string (PREFIX("reshape_%d"), source->ts.kind); + if (source->ts.type == BT_COMPLEX) + f->value.function.name = + gfc_get_string (PREFIX("reshape_%c%d"), + gfc_type_letter (BT_COMPLEX), source->ts.kind); + else + f->value.function.name = + gfc_get_string (PREFIX("reshape_%d"), source->ts.kind); + break; default: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7ee682a9273..74b37015dc0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2005-05-18 Thomas Koenig + + PR libfortran/21127 + * gfortran.dg/reshape-complex.f90: New test. + 2005-05-18 Erik Edelmann * gfortran.dg/array_constructor_1.f90: New test. diff --git a/gcc/testsuite/gfortran.dg/reshape-complex.f90 b/gcc/testsuite/gfortran.dg/reshape-complex.f90 new file mode 100644 index 00000000000..87c80498494 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/reshape-complex.f90 @@ -0,0 +1,11 @@ +! { dg-do run } +! PR 21127: Reshape of complex didn't work. +program main + complex, dimension(8) :: b + complex, dimension(2,2) :: a + integer :: i + b = (/(i,i=1,8)/) + a = reshape(b(1:8:2),shape(a)) + if (a(1,1) /= (1.0, 0.0) .or. a(2,1) /= (3.0, 0.0) .or. & + a(1,2) /= (5.0, 0.0) .or. a(2,2) /= (7.0, 0.0)) call abort +end diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 11fe6d5a522..f2e7bfdd7ae 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,16 @@ +2005-05-18 Thomas Koenig + + PR libfortran/21127 + * Makefile.am: Add generated/reshape_c4.c and + generated/reshape_c8.c. + * Makefile.in: Regenerated. + * m4/iparm.m4: Define rtype_ccode to be c4 or c8 for + complex types, 4 or 8 otherwise. + * m4/reshape.m4: Use rtype_ccode instead of rtype_kind + in function name. + * generated/reshape_c4.c: New file. + * generated/reshape_c8.c: New file. + 2005-05-16 Andreas Jaeger * configure.ac: Add additional warning flags. diff --git a/libgfortran/m4/reshape.m4 b/libgfortran/generated/reshape_c4.c similarity index 91% copy from libgfortran/m4/reshape.m4 copy to libgfortran/generated/reshape_c4.c index 541377f01c5..02d73d258d1 100644 --- a/libgfortran/m4/reshape.m4 +++ b/libgfortran/generated/reshape_c4.c @@ -1,4 +1,4 @@ -`/* Implementation of the RESHAPE +/* Implementation of the RESHAPE Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook @@ -31,22 +31,20 @@ Boston, MA 02111-1307, USA. */ #include "config.h" #include #include -#include "libgfortran.h"' -include(iparm.m4)dnl +#include "libgfortran.h" typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; /* The shape parameter is ignored. We can currently deduce the shape from the return array. */ -dnl Only the kind (ie size) is used to name the function. -extern void reshape_`'rtype_kind (rtype *, rtype *, shape_type *, - rtype *, shape_type *); -export_proto(reshape_`'rtype_kind); +extern void reshape_c4 (gfc_array_c4 *, gfc_array_c4 *, shape_type *, + gfc_array_c4 *, shape_type *); +export_proto(reshape_c4); void -reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, - rtype * pad, shape_type * order) +reshape_c4 (gfc_array_c4 * ret, gfc_array_c4 * source, shape_type * shape, + gfc_array_c4 * pad, shape_type * order) { /* r.* indicates the return array. */ index_type rcount[GFC_MAX_DIMENSIONS]; @@ -57,7 +55,7 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, index_type rsize; index_type rs; index_type rex; - rtype_name *rptr; + GFC_COMPLEX_4 *rptr; /* s.* indicates the source array. */ index_type scount[GFC_MAX_DIMENSIONS]; index_type sextent[GFC_MAX_DIMENSIONS]; @@ -65,16 +63,16 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, index_type sstride0; index_type sdim; index_type ssize; - const rtype_name *sptr; + const GFC_COMPLEX_4 *sptr; /* p.* indicates the pad array. */ index_type pcount[GFC_MAX_DIMENSIONS]; index_type pextent[GFC_MAX_DIMENSIONS]; index_type pstride[GFC_MAX_DIMENSIONS]; index_type pdim; index_type psize; - const rtype_name *pptr; + const GFC_COMPLEX_4 *pptr; - const rtype_name *src; + const GFC_COMPLEX_4 *src; int n; int dim; @@ -100,7 +98,7 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, rs *= rex; } ret->base = 0; - ret->data = internal_malloc_size ( rs * sizeof (rtype_name)); + ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_4)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else @@ -176,9 +174,9 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, if (rsize != 0 && ssize != 0 && psize != 0) { - rsize *= rtype_kind; - ssize *= rtype_kind; - psize *= rtype_kind; + rsize *= 4; + ssize *= 4; + psize *= 4; reshape_packed ((char *)ret->data, rsize, (char *)source->data, ssize, pad ? (char *)pad->data : NULL, psize); return; diff --git a/libgfortran/m4/reshape.m4 b/libgfortran/generated/reshape_c8.c similarity index 91% copy from libgfortran/m4/reshape.m4 copy to libgfortran/generated/reshape_c8.c index 541377f01c5..e6ddf1a1bb9 100644 --- a/libgfortran/m4/reshape.m4 +++ b/libgfortran/generated/reshape_c8.c @@ -1,4 +1,4 @@ -`/* Implementation of the RESHAPE +/* Implementation of the RESHAPE Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook @@ -31,22 +31,20 @@ Boston, MA 02111-1307, USA. */ #include "config.h" #include #include -#include "libgfortran.h"' -include(iparm.m4)dnl +#include "libgfortran.h" typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; /* The shape parameter is ignored. We can currently deduce the shape from the return array. */ -dnl Only the kind (ie size) is used to name the function. -extern void reshape_`'rtype_kind (rtype *, rtype *, shape_type *, - rtype *, shape_type *); -export_proto(reshape_`'rtype_kind); +extern void reshape_c8 (gfc_array_c8 *, gfc_array_c8 *, shape_type *, + gfc_array_c8 *, shape_type *); +export_proto(reshape_c8); void -reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, - rtype * pad, shape_type * order) +reshape_c8 (gfc_array_c8 * ret, gfc_array_c8 * source, shape_type * shape, + gfc_array_c8 * pad, shape_type * order) { /* r.* indicates the return array. */ index_type rcount[GFC_MAX_DIMENSIONS]; @@ -57,7 +55,7 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, index_type rsize; index_type rs; index_type rex; - rtype_name *rptr; + GFC_COMPLEX_8 *rptr; /* s.* indicates the source array. */ index_type scount[GFC_MAX_DIMENSIONS]; index_type sextent[GFC_MAX_DIMENSIONS]; @@ -65,16 +63,16 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, index_type sstride0; index_type sdim; index_type ssize; - const rtype_name *sptr; + const GFC_COMPLEX_8 *sptr; /* p.* indicates the pad array. */ index_type pcount[GFC_MAX_DIMENSIONS]; index_type pextent[GFC_MAX_DIMENSIONS]; index_type pstride[GFC_MAX_DIMENSIONS]; index_type pdim; index_type psize; - const rtype_name *pptr; + const GFC_COMPLEX_8 *pptr; - const rtype_name *src; + const GFC_COMPLEX_8 *src; int n; int dim; @@ -100,7 +98,7 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, rs *= rex; } ret->base = 0; - ret->data = internal_malloc_size ( rs * sizeof (rtype_name)); + ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_8)); ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; } else @@ -176,9 +174,9 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, if (rsize != 0 && ssize != 0 && psize != 0) { - rsize *= rtype_kind; - ssize *= rtype_kind; - psize *= rtype_kind; + rsize *= 8; + ssize *= 8; + psize *= 8; reshape_packed ((char *)ret->data, rsize, (char *)source->data, ssize, pad ? (char *)pad->data : NULL, psize); return; diff --git a/libgfortran/m4/iparm.m4 b/libgfortran/m4/iparm.m4 index b9de9930da6..810f78c3428 100644 --- a/libgfortran/m4/iparm.m4 +++ b/libgfortran/m4/iparm.m4 @@ -30,3 +30,4 @@ define(rtype_qual,`_'rtype_kind)dnl define(atype_max, atype_name`_HUGE')dnl define(atype_min, `-'atype_max)dnl define(name, regexp(regexp(file, `[^/]*$', `\&'), `^\([^_]*\)_', `\1'))dnl +define(rtype_ccode,ifelse(rtype_letter,`c',rtype_code,rtype_kind))dnl diff --git a/libgfortran/m4/reshape.m4 b/libgfortran/m4/reshape.m4 index 541377f01c5..6b411f001ad 100644 --- a/libgfortran/m4/reshape.m4 +++ b/libgfortran/m4/reshape.m4 @@ -40,12 +40,12 @@ typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; return array. */ dnl Only the kind (ie size) is used to name the function. -extern void reshape_`'rtype_kind (rtype *, rtype *, shape_type *, +extern void reshape_`'rtype_ccode (rtype *, rtype *, shape_type *, rtype *, shape_type *); -export_proto(reshape_`'rtype_kind); +export_proto(reshape_`'rtype_ccode); void -reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, +reshape_`'rtype_ccode (rtype * ret, rtype * source, shape_type * shape, rtype * pad, shape_type * order) { /* r.* indicates the return array. */ -- 2.11.4.GIT