diff options
| author | Francois-Xavier Coudert <coudert@clipper.ens.fr> | 2006-06-22 08:04:02 +0200 |
|---|---|---|
| committer | François-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2006-06-22 06:04:02 +0000 |
| commit | ecebfb8be1447048431a3ce0888675412da32678 (patch) | |
| tree | 2fe966f72fa77dacad7c5e1315123bea204e15ec /gcc | |
| parent | 8ac046f2f1134d069de1f9a98aaeaa8f2f3221a6 (diff) | |
| download | gcc-ecebfb8be1447048431a3ce0888675412da32678.zip gcc-ecebfb8be1447048431a3ce0888675412da32678.tar.gz gcc-ecebfb8be1447048431a3ce0888675412da32678.tar.bz2 | |
re PR fortran/26769 (Implement transpose() and reshape() for real instead of using integer)
PR libfortran/26769
* iresolve.c (gfc_resolve_reshape): Call reshape_r4 and
reshape_r8 instead of reshape_4 and reshape_8.
(gfc_resolve_transpose): Likewise for transpose.
* Makefile.am: Add r4 and r8 versions of reshape and transpose.
* Makefile.in: Regenerate.
* generated/reshape_r4.c: New file.
* generated/reshape_r8.c: New file.
* generated/transpose_r4.c: New file.
* generated/transpose_r8.c: New file.
From-SVN: r114880
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/iresolve.c | 34 |
2 files changed, 15 insertions, 26 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a614f1d..55e66cd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2006-06-22 Francois-Xavier Coudert <coudert@clipper.ens.fr> + + PR libfortran/26769 + * iresolve.c (gfc_resolve_reshape): Call reshape_r4 and + reshape_r8 instead of reshape_4 and reshape_8. + (gfc_resolve_transpose): Likewise for transpose. + 2006-06-21 Francois-Xavier Coudert <coudert@clipper.ens.fr> * trans-expr.c (gfc_conv_missing_dummy, gfc_conv_unary_op, diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 3cf84db..f81488a 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -1574,14 +1574,10 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape, case 8: case 10: case 16: - if (source->ts.type == BT_COMPLEX) + if (source->ts.type == BT_COMPLEX || source->ts.type == BT_REAL) f->value.function.name = gfc_get_string (PREFIX("reshape_%c%d"), - gfc_type_letter (BT_COMPLEX), source->ts.kind); - else if (source->ts.type == BT_REAL && (kind == 10 || kind == 16)) - f->value.function.name = - gfc_get_string (PREFIX("reshape_%c%d"), - gfc_type_letter (BT_REAL), source->ts.kind); + gfc_type_letter (source->ts.type), source->ts.kind); else f->value.function.name = gfc_get_string (PREFIX("reshape_%d"), source->ts.kind); @@ -2025,8 +2021,6 @@ gfc_resolve_transfer (gfc_expr * f, gfc_expr * source ATTRIBUTE_UNUSED, void gfc_resolve_transpose (gfc_expr * f, gfc_expr * matrix) { - int kind; - f->ts = matrix->ts; f->rank = 2; if (matrix->shape) @@ -2036,9 +2030,7 @@ gfc_resolve_transpose (gfc_expr * f, gfc_expr * matrix) mpz_init_set (f->shape[1], matrix->shape[0]); } - kind = matrix->ts.kind; - - switch (kind) + switch (matrix->ts.kind) { case 4: case 8: @@ -2046,30 +2038,20 @@ gfc_resolve_transpose (gfc_expr * f, gfc_expr * matrix) case 16: switch (matrix->ts.type) { + case BT_REAL: case BT_COMPLEX: f->value.function.name = - gfc_get_string (PREFIX("transpose_c%d"), kind); + gfc_get_string (PREFIX("transpose_%c%d"), + gfc_type_letter (matrix->ts.type), + matrix->ts.kind); break; - case BT_REAL: - /* There is no kind=10 integer type and on 32-bit targets - there is usually no kind=16 integer type. We need to - call the real version. */ - if (kind == 10 || kind == 16) - { - f->value.function.name = - gfc_get_string (PREFIX("transpose_r%d"), kind); - break; - } - - /* Fall through */ - case BT_INTEGER: case BT_LOGICAL: /* Use the integer routines for real and logical cases. This assumes they all have the same alignment requirements. */ f->value.function.name = - gfc_get_string (PREFIX("transpose_i%d"), kind); + gfc_get_string (PREFIX("transpose_i%d"), matrix->ts.kind); break; default: |