Min, MAX and ishft(c).

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 54a84ae40756ee3b9e38757ab334157e97320e85..108e05dbe74ebec42ca08492ccb1f39787cb1f3d 100644 (file)
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -3472,8 +3472,18 @@ gfc_check_intconv (gfc_expr *x)
 bool
 gfc_check_ishft (gfc_expr *i, gfc_expr *shift)
 {
-  if (!type_check (i, 0, BT_INTEGER)
-      || !type_check (shift, 1, BT_INTEGER))
+  if (flag_unsigned)
+    {
+      if (!type_check2 (i, 0, BT_INTEGER, BT_UNSIGNED))
+       return false;
+    }
+  else
+    {
+      if (!type_check (i, 0, BT_INTEGER))
+       return false;
+    }
+
+  if (!type_check (shift, 1, BT_INTEGER))
     return false;
 
   if (!less_than_bitsize1 ("I", i, NULL, shift, true))
@@ -3486,9 +3496,16 @@ gfc_check_ishft (gfc_expr *i, gfc_expr *shift)
 bool
 gfc_check_ishftc (gfc_expr *i, gfc_expr *shift, gfc_expr *size)
 {
-  if (!type_check (i, 0, BT_INTEGER)
-      || !type_check (shift, 1, BT_INTEGER))
-    return false;
+  if (flag_unsigned)
+    {
+      if (!type_check2 (i, 0, BT_INTEGER, BT_UNSIGNED))
+       return false;
+    }
+  else
+    {
+      if (!type_check (i, 0, BT_INTEGER))
+       return false;
+    }
 
   if (size != NULL)
     {
@@ -3962,11 +3979,29 @@ gfc_check_min_max (gfc_actual_arglist *arg)
                           gfc_current_intrinsic, &x->where))
        return false;
     }
-  else if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL)
+  else
     {
-      gfc_error ("%<a1%> argument of %qs intrinsic at %L must be INTEGER, "
-                "REAL or CHARACTER", gfc_current_intrinsic, &x->where);
-      return false;
+      if (flag_unsigned)
+       {
+         if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL
+             && x->ts.type != BT_UNSIGNED)
+           {
+             gfc_error ("%<a1%> argument of %qs intrinsic at %L must be "
+                        "INTEGER, REAL, CHARACTER or UNSIGNED",
+                        gfc_current_intrinsic, &x->where);
+             return false;
+           }
+       }
+      else
+       {
+         if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL)
+           {
+             gfc_error ("%<a1%> argument of %qs intrinsic at %L must be "
+                        "INTEGER, REAL or CHARACTER",
+                        gfc_current_intrinsic, &x->where);
+             return false;
+           }
+       }
     }
 
   return check_rest (x->ts.type, x->ts.kind, arg);

diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 1afd12fcf14c72adbc5355b797f84a750154d336..aeb4fe9ee0bc8ccec165b9640e986ece45da70a6 100644 (file)
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -2766,6 +2766,8 @@ As of now, the following intrinsics take unsigned arguments:
 @item @code{BIT_SIZE}, @code{DIGITS} and @code{HUGE}
 @item @code{DSHIFTL} and @code{DSHIFTR}
 @item @code{IBCLR}, @code{IBITS} and @code{IBITS}
+@item @code{MIN} and @code{MAX}
+@item @code{ISHFT} and @code{ISHFTC}
 @end itemize
 This list will grow in the near future.
 @c ---------------------------------------------------------------------

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index b7b280754e90879a8e7504c407540f0432dc0ace..05396035b58e51bd5e5be1fd822264b60bd21c8d 100644 (file)
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -3931,8 +3931,11 @@ simplify_shift (gfc_expr *e, gfc_expr *s, const char *name,
 
   gfc_extract_int (s, &shift);
 
-  k = gfc_validate_kind (BT_INTEGER, e->ts.kind, false);
-  bitsize = gfc_integer_kinds[k].bit_size;
+  k = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+  if (e->ts.type == BT_INTEGER)
+    bitsize = gfc_integer_kinds[k].bit_size;
+  else
+    bitsize = gfc_unsigned_kinds[k].bit_size;
 
   result = gfc_get_constant_expr (e->ts.type, e->ts.kind, &e->where);
 
@@ -4008,7 +4011,11 @@ simplify_shift (gfc_expr *e, gfc_expr *s, const char *name,
        }
     }
 
-  gfc_convert_mpz_to_signed (result->value.integer, bitsize);
+  if (result->ts.type == BT_INTEGER)
+    gfc_convert_mpz_to_signed (result->value.integer, bitsize);
+  else
+    gfc_reduce_unsigned(result);
+
   free (bits);
 
   return result;
@@ -4108,7 +4115,8 @@ gfc_simplify_ishftc (gfc_expr *e, gfc_expr *s, gfc_expr *sz)
   if (shift == 0)
     return result;
 
-  gfc_convert_mpz_to_unsigned (result->value.integer, isize);
+  if (result->ts.type == BT_INTEGER)
+    gfc_convert_mpz_to_unsigned (result->value.integer, isize);
 
   bits = XCNEWVEC (int, ssize);
 
@@ -4154,7 +4162,8 @@ gfc_simplify_ishftc (gfc_expr *e, gfc_expr *s, gfc_expr *sz)
        }
     }
 
-  gfc_convert_mpz_to_signed (result->value.integer, isize);
+  if (result->ts.type == BT_INTEGER)
+    gfc_convert_mpz_to_signed (result->value.integer, isize);
 
   free (bits);
   return result;
@@ -5243,6 +5252,7 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign, bool back_val)
   switch (arg->ts.type)
     {
       case BT_INTEGER:
+      case BT_UNSIGNED:
        if (extremum->ts.kind < arg->ts.kind)
          extremum->ts.kind = arg->ts.kind;
        ret = mpz_cmp (arg->value.integer,

diff --git a/gcc/testsuite/gfortran.dg/unsigned_11.f90 b/gcc/testsuite/gfortran.dg/unsigned_11.f90
new file mode 100644 (file)
index 0000000..ad817a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_11.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test min/max
+program main
+  unsigned :: u_a, u_b
+  if (max(1u,2u) /= 2u) error stop 1
+  if (max(2u,1u) /= 2u) error stop 2
+  if (min(1u,2u) /= 1u) error stop 3
+  if (min(2u,1u) /= 1u) error stop 4
+  u_a = 1u
+  u_b = 2u
+  if (max(u_a,u_b) /= u_b) error stop 5
+  if (max(u_b,u_a) /= u_b) error stop 6
+  if (min(u_a,u_b) /= u_a) error stop 7
+  if (min(u_b,u_a) /= u_a) error stop 8
+  if (max(4294967295u, 1u) /= 4294967295u) error stop 9
+  u_a = 4294967295u
+  u_b = 1u
+  if (max(u_a,u_b) /= 4294967295u) error stop 10
+  if (max(u_b,u_a) /= 4294967295u) error stop 11
+  if (min(u_a,u_b) /= 1u) error stop 12
+  if (min(u_b,u_a) /= 1u) error stop 13
+end program

diff --git a/gcc/testsuite/gfortran.dg/unsigned_12.f90 b/gcc/testsuite/gfortran.dg/unsigned_12.f90
new file mode 100644 (file)
index 0000000..ecf8214
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_12.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test some
+program main
+  unsigned :: u_a
+  u_a = 1u
+  if (ishft(1u,31) /= 2147483648u) stop 1
+  if (ishft(u_a,31) /= 2147483648u) stop 2
+
+  u_a = 3u
+  if (ishft(3u,2) /= 12u) stop 3
+  if (ishft(u_a,2) /= 12u) stop 4
+
+  u_a = huge(u_a)
+  if (ishftc(huge(u_a),1) /= huge(u_a)) stop 5
+  if (ishftc(u_a,1) /= u_a) stop 6
+
+end program

diff --git a/gcc/testsuite/gfortran.dg/unsigned_13.f90 b/gcc/testsuite/gfortran.dg/unsigned_13.f90
new file mode 100644 (file)
index 0000000..79b0907
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_13.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+! Test basic functionality of ishft and ishftc.
+program main
+  unsigned :: u_a
+  u_a = 1u
+  if (ishft(1u,31) /= 2147483648u) stop 1
+  if (ishft(u_a,31) /= 2147483648u) stop 2
+
+  u_a = 3u
+  if (ishft(3u,2) /= 12u) stop 3
+  if (ishft(u_a,2) /= 12u) stop 4
+
+  u_a = huge(u_a)
+  if (ishftc(huge(u_a),1) /= huge(u_a)) stop 5
+  if (ishftc(u_a,1) /= u_a) stop 6
+
+end program