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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127205 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5d1695b..2e29300 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+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

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 32ed6da..5c49135 100644 (file)
--- 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 dc67240..2dbbacc 100644 (file)
--- 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 9371c1c..aa74703 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/selected_kind_1.f90 b/gcc/testsuite/gfortran.dg/selected_kind_1.f90
new file mode 100644 (file)
index 0000000..0c71054
--- /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
+