From 26ef8a2cd2252052953cce299ff5cc9e572d3996 Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Sat, 4 Aug 2007 16:48:50 +0000 Subject: [PATCH] re PR fortran/32968 (selected_(int|real)_kind fail with -fdefault-integer-8) 2008-08-04 Steven G. Kargl PR fortran/32968 * gfortran.dg/selected_kind_1.f90: New test. 2008-08-04 Steven G. Kargl PR fortran/32969 * iresolve.c (gfc_resolve_rrspacing): Convert argument(s) to expected KIND. (gfc_resolve_scale): Ditto. (gfc_resolve_set_exponent): Ditto. (gfc_resolve_spacing): Ditto. PR fortran/32968 * trans-intrinsic.c (gfc_conv_intrinsic_si_kind, gfc_conv_intrinsic_sr_kind): Convert the argument(s) to the expected KIND, and fold the result to the expected KIND. From-SVN: r127205 --- gcc/fortran/ChangeLog | 14 ++++++++ gcc/fortran/iresolve.c | 32 +++++++++++++++-- gcc/fortran/trans-intrinsic.c | 34 +++++++++++++++---- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/selected_kind_1.f90 | 16 +++++++++ 5 files changed, 92 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/selected_kind_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5d1695bf2e4..2e29300e7be 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,17 @@ +2008-08-04 Steven G. Kargl + + PR fortran/32969 + * iresolve.c (gfc_resolve_rrspacing): Convert argument(s) to + expected KIND. + (gfc_resolve_scale): Ditto. + (gfc_resolve_set_exponent): Ditto. + (gfc_resolve_spacing): Ditto. + + PR fortran/32968 + * trans-intrinsic.c (gfc_conv_intrinsic_si_kind, + gfc_conv_intrinsic_sr_kind): Convert the argument(s) to the + expected KIND, and fold the result to the expected KIND. + 2007-08-03 Francois-Xavier Coudert PR fortran/31202 diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 32ed6da5645..5c491355908 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -1742,6 +1742,14 @@ gfc_resolve_rrspacing (gfc_expr *f, gfc_expr *x) prec = gfc_get_actual_arglist (); prec->name = "p"; prec->expr = gfc_int_expr (gfc_real_kinds[k].digits); + /* The library routine expects INTEGER(4). */ + if (prec->expr->ts.kind != gfc_c_int_kind) + { + gfc_typespec ts; + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + gfc_convert_type (prec->expr, &ts, 2); + } f->value.function.actual->next = prec; } @@ -1757,7 +1765,7 @@ gfc_resolve_scale (gfc_expr *f, gfc_expr *x, gfc_expr *i) { gfc_typespec ts; ts.type = BT_INTEGER; - ts.kind = gfc_default_integer_kind; + ts.kind = gfc_c_int_kind; gfc_convert_type_warn (i, &ts, 2, 0); } @@ -1792,11 +1800,11 @@ gfc_resolve_set_exponent (gfc_expr *f, gfc_expr *x, gfc_expr *i) /* The library implementation uses GFC_INTEGER_4 unconditionally, convert type so we don't have to implement all possible permutations. */ - if (i->ts.kind != 4) + if (i->ts.kind != gfc_c_int_kind) { gfc_typespec ts; ts.type = BT_INTEGER; - ts.kind = gfc_default_integer_kind; + ts.kind = gfc_c_int_kind; gfc_convert_type_warn (i, &ts, 2, 0); } @@ -1892,11 +1900,29 @@ gfc_resolve_spacing (gfc_expr *f, gfc_expr *x) emin_1 = gfc_get_actual_arglist (); emin_1->name = "emin"; emin_1->expr = gfc_int_expr (gfc_real_kinds[k].min_exponent - 1); + + /* The library routine expects INTEGER(4). */ + if (emin_1->expr->ts.kind != gfc_c_int_kind) + { + gfc_typespec ts; + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + gfc_convert_type (emin_1->expr, &ts, 2); + } emin_1->next = tiny; prec = gfc_get_actual_arglist (); prec->name = "prec"; prec->expr = gfc_int_expr (gfc_real_kinds[k].digits); + + /* The library routine expects INTEGER(4). */ + if (prec->expr->ts.kind != gfc_c_int_kind) + { + gfc_typespec ts; + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + gfc_convert_type (prec->expr, &ts, 2); + } prec->next = emin_1; f->value.function.actual->next = prec; diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index dc672401b42..2dbbacce221 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -3493,22 +3493,30 @@ gfc_conv_intrinsic_verify (gfc_se * se, gfc_expr * expr) /* Generate code for SELECTED_INT_KIND (R) intrinsic function. */ static void -gfc_conv_intrinsic_si_kind (gfc_se * se, gfc_expr * expr) +gfc_conv_intrinsic_si_kind (gfc_se *se, gfc_expr *expr) { - tree arg; + tree arg, type; gfc_conv_intrinsic_function_args (se, expr, &arg, 1); - arg = build_fold_addr_expr (arg); + + /* The argument to SELECTED_INT_KIND is INTEGER(4). */ + type = gfc_get_int_type (4); + arg = build_fold_addr_expr (fold_convert (type, arg)); + + /* Convert it to the required type. */ + type = gfc_typenode_for_spec (&expr->ts); se->expr = build_call_expr (gfor_fndecl_si_kind, 1, arg); + se->expr = fold_convert (type, se->expr); } + /* Generate code for SELECTED_REAL_KIND (P, R) intrinsic function. */ static void -gfc_conv_intrinsic_sr_kind (gfc_se * se, gfc_expr * expr) +gfc_conv_intrinsic_sr_kind (gfc_se *se, gfc_expr *expr) { gfc_actual_arglist *actual; - tree args; + tree args, type; gfc_se argse; args = NULL_TREE; @@ -3520,13 +3528,27 @@ gfc_conv_intrinsic_sr_kind (gfc_se * se, gfc_expr * expr) if (actual->expr == NULL) argse.expr = null_pointer_node; else - gfc_conv_expr_reference (&argse, actual->expr); + { + gfc_typespec ts; + if (actual->expr->ts.kind != gfc_c_int_kind) + { + /* The arguments to SELECTED_REAL_KIND are INTEGER(4). */ + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + gfc_convert_type (actual->expr, &ts, 2); + } + gfc_conv_expr_reference (&argse, actual->expr); + } gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->post, &argse.post); args = gfc_chainon_list (args, argse.expr); } + + /* Convert it to the required type. */ + type = gfc_typenode_for_spec (&expr->ts); se->expr = build_function_call_expr (gfor_fndecl_sr_kind, args); + se->expr = fold_convert (type, se->expr); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9371c1cb04e..aa747033b64 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-08-04 Steven G. Kargl + + PR fortran/32968 + * gfortran.dg/selected_kind_1.f90: New test. + 2007-08-04 Andrew Pinski PR middle-end/32780 diff --git a/gcc/testsuite/gfortran.dg/selected_kind_1.f90 b/gcc/testsuite/gfortran.dg/selected_kind_1.f90 new file mode 100644 index 00000000000..0c710546d4e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/selected_kind_1.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! { dg-options "-fdefault-integer-8" } +! PR fortran/32968 +program selected + + if (selected_int_kind (1) /= 1) call abort + if (selected_int_kind (3) /= 2) call abort + if (selected_int_kind (5) /= 4) call abort + if (selected_int_kind (10) /= 8) call abort + if (selected_real_kind (1) /= 4) call abort + if (selected_real_kind (2) /= 4) call abort + if (selected_real_kind (9) /= 8) call abort + if (selected_real_kind (10) /= 8) call abort + +end program selected + -- 2.30.2