Got some basic arithmetic working, test case now run-time.

8 files changed, 97 insertions, 30 deletions

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index b373c25..a7b8af7 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -1719,14 +1719,25 @@ eval_intrinsic (gfc_intrinsic_op op,
 
     gcc_fallthrough ();
     /* Numeric binary  */
+    case INTRINSIC_POWER:
+      if (flag_unsigned)
+	{
+	  if (op1->ts.type == BT_UNSIGNED || op2->ts.type == BT_UNSIGNED)
+	    goto runtime;
+	}
+
+      gcc_fallthrough();
+
     case INTRINSIC_PLUS:
     case INTRINSIC_MINUS:
     case INTRINSIC_TIMES:
     case INTRINSIC_DIVIDE:
-    case INTRINSIC_POWER:
       if (!gfc_numeric_ts (&op1->ts) || !gfc_numeric_ts (&op2->ts))
 	goto runtime;
 
+      if (flag_unsigned && gfc_invalid_unsigned_ops (op1, op2))
+	goto runtime;
+
       /* Do not perform conversions if operands are not conformable as
 	 required for the binary intrinsic operators (F2018:10.1.5).
 	 Defer to a possibly overloading user-defined operator.  */
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 2f50d84..e90a99d 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -7637,3 +7637,12 @@ gfc_check_storage_size (gfc_expr *a, gfc_expr *kind)
 
   return true;
 }
+
+/* Check two operands that either both or none of them can
+   be UNSIGNED.  */
+
+bool
+gfc_invalid_unsigned_ops (gfc_expr * op1, gfc_expr * op2)
+{
+  return (op1->ts.type == BT_UNSIGNED) + (op2->ts.type == BT_UNSIGNED) == 1;
+}
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 2c1f965..545a64d 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -903,7 +903,8 @@ gfc_kind_max (gfc_expr *e1, gfc_expr *e2)
 static bool
 numeric_type (bt type)
 {
-  return type == BT_COMPLEX || type == BT_REAL || type == BT_INTEGER;
+  return type == BT_COMPLEX || type == BT_REAL || type == BT_INTEGER
+    || type == BT_UNSIGNED;
 }
 
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index d51960f..3e20821 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -4021,6 +4021,7 @@ bool gfc_boz2real (gfc_expr *, int);
 bool gfc_invalid_boz (const char *, locus *);
 bool gfc_invalid_null_arg (gfc_expr *);
 
+bool gfc_invalid_unsigned_ops (gfc_expr *, gfc_expr *);
 
 /* class.cc */
 void gfc_fix_class_refs (gfc_expr *e);
@@ -4103,6 +4104,7 @@ void gfc_convert_mpz_to_signed (mpz_t, int);
 gfc_expr *gfc_simplify_ieee_functions (gfc_expr *);
 bool gfc_is_constant_array_expr (gfc_expr *);
 bool gfc_is_size_zero_array (gfc_expr *);
+void gfc_convert_mpz_to_unsigned (mpz_t, int);
 
 /* trans-array.cc  */
 
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index d2a6e69..c1aa0bc 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -210,20 +210,27 @@ convert_integer (const char *buffer, int kind, int radix, locus *where)
 
 
 /* Convert an unsigned string to an expression node.  XXX:
-   This needs a calculation modulo 2^n.  */
+   This needs a calculation modulo 2^n.  TODO: Implement restriction
+   that no unary minus is permitted.  */
 static gfc_expr *
 convert_unsigned (const char *buffer, int kind, int radix, locus *where)
 {
   gfc_expr *e;
-  mpz_t tmp;
-  mpz_init_set_ui (tmp, 1);
-  /* XXX  Change this later.  */
-  mpz_mul_2exp (tmp, tmp, kind * 8);
-  mpz_sub_ui (tmp, tmp, 1);
+  const char *t;
+  int k;
+
   e = gfc_get_constant_expr (BT_UNSIGNED, kind, where);
-  mpz_set_str (e->value.integer, buffer, radix);
-  mpz_and (e->value.integer, e->value.integer, tmp);
-  mpz_clear (tmp);
+  /* A leading plus is allowed, but not by mpz_set_str.  */
+  if (buffer[0] == '+')
+    t = buffer + 1;
+  else
+    t = buffer;
+
+  mpz_set_str (e->value.integer, t, radix);
+
+  k = gfc_validate_kind (BT_UNSIGNED, kind, false);
+  gfc_convert_mpz_to_unsigned (e->value.integer, gfc_unsigned_kinds[k].bit_size);
+
   return e;
 }
 
@@ -333,9 +340,15 @@ match_unsigned_constant (gfc_expr **result)
   gfc_gobble_whitespace ();
 
   length = match_digits (/* signflag = */ false, 10, NULL);
-  gfc_current_locus = old_loc;
+
   if (length == -1)
-    return MATCH_NO;
+    goto fail;
+
+  m = gfc_match_char ('u');
+  if (m == MATCH_NO)
+    goto fail;
+
+  gfc_current_locus = old_loc;
 
   buffer = (char *) alloca (length + 1);
   memset (buffer, '\0', length + 1);
@@ -343,9 +356,10 @@ match_unsigned_constant (gfc_expr **result)
   gfc_gobble_whitespace ();
 
   match_digits (false, 10, buffer);
+
   m = gfc_match_char ('u');
   if (m == MATCH_NO)
-    return m;
+    goto fail;
 
   kind = get_kind (&is_iso_c);
   if (kind == -2)
@@ -368,6 +382,9 @@ match_unsigned_constant (gfc_expr **result)
   *result = e;
   return MATCH_YES;
 
+ fail:
+  gfc_current_locus = old_loc;
+  return MATCH_NO;
 }
 
 /* Match a Hollerith constant.  */
@@ -4419,4 +4436,3 @@ gfc_match_equiv_variable (gfc_expr **result)
 {
   return match_variable (result, 1, 0);
 }
-
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 5030293..98ad7ae 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -4232,11 +4232,36 @@ resolve_operator (gfc_expr *e)
 		gfc_op2string (e->value.op.op), gfc_typename (e));
       goto bad_op;
 
+    case INTRINSIC_POWER:
+
+      if (flag_unsigned)
+	{
+	  if (op1->ts.type == BT_UNSIGNED || op2->ts.type == BT_UNSIGNED)
+	    {
+	      snprintf (msg, sizeof(msg),
+			_("Exponentiation not valid at %%L for %s and %s"),
+			gfc_typename (op1), gfc_typename (op2));
+	      goto bad_op;
+	    }
+	}
+      gcc_fallthrough();
+
     case INTRINSIC_PLUS:
     case INTRINSIC_MINUS:
     case INTRINSIC_TIMES:
     case INTRINSIC_DIVIDE:
-    case INTRINSIC_POWER:
+
+      /* UNSIGNED cannot appear in a mixed expression without explicit
+	     conversion.  */
+      if (flag_unsigned &&  gfc_invalid_unsigned_ops (op1, op2))
+	{
+	  snprintf (msg, sizeof(msg),
+		    _("Operands of binary numeric operator %%<%s%%> at %%L are %s/%s"),
+		    gfc_op2string (e->value.op.op), gfc_typename (op1),
+		    gfc_typename (op2));
+	  goto bad_op;
+	}
+
       if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
 	{
 	  /* Do not perform conversions if operands are not conformable as
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 8ddd491..18c9088 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -147,8 +147,8 @@ get_kind (bt type, gfc_expr *k, const char *name, int default_kind)
    The conversion is a no-op unless x is negative; otherwise, it can
    be accomplished by masking out the high bits.  */
 
-static void
-convert_mpz_to_unsigned (mpz_t x, int bitsize)
+void
+gfc_convert_mpz_to_unsigned (mpz_t x, int bitsize)
 {
   mpz_t mask;
 
@@ -1693,11 +1693,11 @@ compare_bitwise (gfc_expr *i, gfc_expr *j)
 
   mpz_init_set (x, i->value.integer);
   k = gfc_validate_kind (i->ts.type, i->ts.kind, false);
-  convert_mpz_to_unsigned (x, gfc_integer_kinds[k].bit_size);
+  gfc_convert_mpz_to_unsigned (x, gfc_integer_kinds[k].bit_size);
 
   mpz_init_set (y, j->value.integer);
   k = gfc_validate_kind (j->ts.type, j->ts.kind, false);
-  convert_mpz_to_unsigned (y, gfc_integer_kinds[k].bit_size);
+  gfc_convert_mpz_to_unsigned (y, gfc_integer_kinds[k].bit_size);
 
   res = mpz_cmp (x, y);
   mpz_clear (x);
@@ -3403,7 +3403,7 @@ gfc_simplify_ibclr (gfc_expr *x, gfc_expr *y)
       result->representation.string = NULL;
     }
 
-  convert_mpz_to_unsigned (result->value.integer,
+  gfc_convert_mpz_to_unsigned (result->value.integer,
 			   gfc_integer_kinds[k].bit_size);
 
   mpz_clrbit (result->value.integer, pos);
@@ -3446,7 +3446,7 @@ gfc_simplify_ibits (gfc_expr *x, gfc_expr *y, gfc_expr *z)
     }
 
   result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
-  convert_mpz_to_unsigned (result->value.integer,
+  gfc_convert_mpz_to_unsigned (result->value.integer,
 			   gfc_integer_kinds[k].bit_size);
 
   bits = XCNEWVEC (int, bitsize);
@@ -3501,7 +3501,7 @@ gfc_simplify_ibset (gfc_expr *x, gfc_expr *y)
       result->representation.string = NULL;
     }
 
-  convert_mpz_to_unsigned (result->value.integer,
+  gfc_convert_mpz_to_unsigned (result->value.integer,
 			   gfc_integer_kinds[k].bit_size);
 
   mpz_setbit (result->value.integer, pos);
@@ -4000,7 +4000,7 @@ gfc_simplify_ishftc (gfc_expr *e, gfc_expr *s, gfc_expr *sz)
   if (shift == 0)
     return result;
 
-  convert_mpz_to_unsigned (result->value.integer, isize);
+  gfc_convert_mpz_to_unsigned (result->value.integer, isize);
 
   bits = XCNEWVEC (int, ssize);
 
@@ -6648,7 +6648,7 @@ gfc_simplify_popcnt (gfc_expr *e)
 
   /* Convert argument to unsigned, then count the '1' bits.  */
   mpz_init_set (x, e->value.integer);
-  convert_mpz_to_unsigned (x, gfc_integer_kinds[k].bit_size);
+  gfc_convert_mpz_to_unsigned (x, gfc_integer_kinds[k].bit_size);
   res = mpz_popcount (x);
   mpz_clear (x);
 
diff --git a/gcc/testsuite/gfortran.dg/unsigned_1.f90 b/gcc/testsuite/gfortran.dg/unsigned_1.f90
index e8caadc..a5f110a 100644
--- a/gcc/testsuite/gfortran.dg/unsigned_1.f90
+++ b/gcc/testsuite/gfortran.dg/unsigned_1.f90
@@ -1,8 +1,11 @@
-! { dg-do compile }
+! { dg-do run }
 ! { dg-options "-funsigned" }
-! A first, very simple program, that should compile.
+! Test basic assignment, arithmetic and a condition.
 program memain
-  unsigned :: u
-  u = 1U
-  u = 2u
+  unsigned :: u, v
+  u = 1u
+  v = 42u
+  if (u + v /= 43u) then
+     stop 1
+  end if
 end program memain