[m-rev.] for review: fix bug #158

[Peter Wang]

Branches: main, 10.04

When a foreign_proc output variable of type `char' is assigned to an
MR_Word variable, it must first be cast to an MR_UnsignedChar to prevent
sign-extension of 8-bit character values.  This was documented in
mercury_string.h.

Fixes bug #158.

compiler/llds_out_instr.m:
        As above.

tests/hard_coded/Mmakefile:
tests/hard_coded/char_signed.exp:
tests/hard_coded/char_signed.m:
        Add test case.

diff --git a/compiler/llds_out_instr.m b/compiler/llds_out_instr.m
index abdc6dc..1df9d9f 100644
--- a/compiler/llds_out_instr.m
+++ b/compiler/llds_out_instr.m
@@ -1951,17 +1951,26 @@ output_foreign_proc_output(Info, Output, !IO) :-
             MaybeForeignType = no,
             output_lval_as_word(Info, Lval, !IO),
             io.write_string(" = ", !IO),
-            (
-                OrigType = builtin_type(builtin_type_string)
-            ->
-                output_llds_type_cast(lt_word, !IO),
-                io.write_string(VarName, !IO)
-            ;
-                OrigType = builtin_type(builtin_type_float)
-            ->
-                io.write_string("MR_float_to_word(", !IO),
-                io.write_string(VarName, !IO),
-                io.write_string(")", !IO)
+            ( OrigType = builtin_type(BuiltinType) ->
+                (
+                    BuiltinType = builtin_type_string,
+                    output_llds_type_cast(lt_word, !IO),
+                    io.write_string(VarName, !IO)
+                ;
+                    BuiltinType = builtin_type_float,
+                    io.write_string("MR_float_to_word(", !IO),
+                    io.write_string(VarName, !IO),
+                    io.write_string(")", !IO)
+                ;
+                    BuiltinType = builtin_type_char,
+                    % Characters must be cast to MR_UnsignedChar to
+                    % prevent sign-extension.
+                    io.write_string("(MR_UnsignedChar) ", !IO),
+                    io.write_string(VarName, !IO)
+                ;
+                    BuiltinType = builtin_type_int,
+                    io.write_string(VarName, !IO)
+                )
             ;
                 io.write_string(VarName, !IO)
             )
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index 1cf78d3..ddee18d 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -21,6 +21,7 @@ ORDINARY_PROGS=	\
 	cc_and_non_cc_test \
 	cc_multi_bug \
 	cc_nondet_disj \
+	char_signed \
 	checked_nondet_tailcall \
 	checked_nondet_tailcall_noinline \
 	closure_extension \
diff --git a/tests/hard_coded/char_signed.exp b/tests/hard_coded/char_signed.exp
new file mode 100644
index 0000000..ad94b65
--- /dev/null
+++ b/tests/hard_coded/char_signed.exp
@@ -0,0 +1,4 @@
+unify succeed
+'A' < 0xFF
+0xFF >= 'A'
+'A' < 0xFF
diff --git a/tests/hard_coded/char_signed.m b/tests/hard_coded/char_signed.m
new file mode 100644
index 0000000..7700a6a
--- /dev/null
+++ b/tests/hard_coded/char_signed.m
@@ -0,0 +1,43 @@
+% Bug 158 and related issues with 8-bit characters due to MR_Char being
+% signed (potentially).
+
+:- module char_signed.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module char.
+:- import_module int.
+
+main(!IO) :-
+    ( char.det_from_int(255) = '\xFF\' ->
+        io.write_string("unify succeed\n", !IO)
+    ;
+        io.write_string("unify fail\n", !IO)
+    ),
+    ( aa @< '\xFF\' ->
+        io.write_string("'A' < 0xFF\n", !IO)
+    ;
+        io.write_string("'A' >= 0xFF (wrong)\n", !IO)
+    ),
+    ( '\xFF\' @< aa ->
+        io.write_string("0xFF < 'A' (wrong)\n", !IO)
+    ;
+        io.write_string("0xFF >= 'A'\n", !IO)
+    ),
+    ( char.to_int('A') < char.to_int('\xFF\') : int ->
+        io.write_string("'A' < 0xFF\n", !IO)
+    ;
+        io.write_string("'A' >= 0xFF (wrong)\n", !IO)
+    ).
+
+:- func aa = char.
+:- pragma no_inline(aa/0).
+
+aa = char.det_from_int(65).
+
+% vim: ft=mercury ts=8 sts=4 sw=4 et

--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------