From ecebfb8be1447048431a3ce0888675412da32678 Mon Sep 17 00:00:00 2001 From: Francois-Xavier Coudert Date: Thu, 22 Jun 2006 08:04:02 +0200 Subject: 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 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/iresolve.c | 34 ++++++++-------------------------- 2 files changed, 15 insertions(+), 26 deletions(-) (limited to 'gcc/fortran') 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 + + 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 * 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: -- cgit v1.1