https://gcc.gnu.org/g:f70cf64690ab718b40763be506ec47e135e666f3
commit f70cf64690ab718b40763be506ec47e135e666f3
Author: Thomas Koenig <tkoe...@gcc.gnu.org>
Date: Wed Jul 24 22:35:49 2024 +0200
Got some basic arithmetic working, test case now run-time.
Diff:
---
gcc/fortran/arith.cc | 13 +++++++++-
gcc/fortran/check.cc | 9 +++++++
gcc/fortran/expr.cc | 3 ++-
gcc/fortran/gfortran.h | 2 ++
gcc/fortran/primary.cc | 42 ++++++++++++++++++++++----------
gcc/fortran/resolve.cc | 27 +++++++++++++++++++-
gcc/fortran/simplify.cc | 18 +++++++-------
gcc/testsuite/gfortran.dg/unsigned_1.f90 | 13 ++++++----
8 files changed, 97 insertions(+), 30 deletions(-)
diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index b373c25e5e12..a7b8af7779d1 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 2f50d84b876f..e90a99df1e2b 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 2c1f965c73a2..545a64dba239 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 d51960ff0d31..3e20821cceae 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 d2a6e69fa428..c1aa0bc77c91 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 503029364c14..98ad7aef42b4 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 8ddd491de113..18c9088ef667 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 e8caadca9d98..a5f110aa0ab5 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
