+2008-08-04 Steven G. Kargl <kargl@gcc.gnu.org>
+
+ 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 <fxcoudert@gcc.gnu.org>
PR fortran/31202
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;
}
{
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);
}
/* 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);
}
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;
/* 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;
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);
}
+2008-08-04 Steven G. Kargl <kargl@gcc.gnu.org>
+
+ PR fortran/32968
+ * gfortran.dg/selected_kind_1.f90: New test.
+
2007-08-04 Andrew Pinski <andrew_pinski@playstation.sony.com>
PR middle-end/32780
--- /dev/null
+! { 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
+