re PR fortran/32968 (selected_(int|real)_kind fail with -fdefault-integer-8)

2008-08-04  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/32968
	* gfortran.dg/selected_kind_1.f90: New test.

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.

From-SVN: r127205

gcc/fortran/ChangeLog

+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

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;

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);
 }
 
 

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/selected_kind_1.f90

+! { 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
+