[Committed] Fix fortran/32968 and 32969.

[Committed] Fix fortran/32968 and 32969.

[Steve Kargl]

[-- Attachment #1: Type: text/plain, Size: 901 bytes --]

The attached patch fixes more of the -fdefault-integer-8 fallout.
It forces the arguments and return KIND for several functions
to match the KIND expected by the library or return value.

It eas regression tested on amd64-*-freebsd by me.  FX had
approved a portion of the patch and Dominique tested a portion
on some flavor of ppc*-*-darwin.

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.

-- 
Steve

[-- Attachment #2: a.diff --]
[-- Type: text/x-diff, Size: 5195 bytes --]

Index: testsuite/gfortran.dg/selected_kind_1.f90
===================================================================
--- testsuite/gfortran.dg/selected_kind_1.f90	(revision 0)
+++ testsuite/gfortran.dg/selected_kind_1.f90	(revision 0)
@@ -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
+
Index: fortran/iresolve.c
===================================================================
--- fortran/iresolve.c	(revision 127167)
+++ fortran/iresolve.c	(working copy)
@@ -1742,6 +1742,14 @@ gfc_resolve_rrspacing (gfc_expr *f, gfc_
   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
     {
       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, g
   /* 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_ex
   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;
Index: fortran/trans-intrinsic.c
===================================================================
--- fortran/trans-intrinsic.c	(revision 127167)
+++ fortran/trans-intrinsic.c	(working copy)
@@ -3465,22 +3465,30 @@ gfc_conv_intrinsic_verify (gfc_se * se, 
 /* 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;
@@ -3492,13 +3500,27 @@ gfc_conv_intrinsic_sr_kind (gfc_se * se,
       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);
 }