summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
authorJohn Ericson <John.Ericson@Obsidian.Systems>2021-06-10 23:14:35 +0000
committerJohn Ericson <John.Ericson@Obsidian.Systems>2021-07-21 22:51:41 +0000
commite8f7734d8a052f99b03e1123466dc9f47b48c311 (patch)
treefda662d428a825c69d24b204a9777d4f70235acd /testsuite
parent10124b16538091806953d732e24ca485a0664895 (diff)
downloadhaskell-e8f7734d8a052f99b03e1123466dc9f47b48c311.tar.gz
Fix #19931
The issue was the renderer for x86 addressing modes assumes native size registers, but we were passing in a possibly-smaller index in conjunction with a native-sized base pointer. The easist thing to do is just extend the register first. I also changed the other NGC backends implementing jump tables accordingly. On one hand, I think PowerPC and Sparc don't have the small sub-registers anyways so there is less to worry about. On the other hand, to the extent that's true the zero extension can become a no-op. I should give credit where it's due: @hsyl20 really did all the work for me in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4717#note_355874, but I was daft and missed the "Oops" and so ended up spending a silly amount of time putting it all back together myself. The unregisterised backend change is a bit different, because here we are translating the actual case not a jump table, and the fix is to handle right-sized literals not addressing modes. But it makes sense to include here too because it's the same change in the subsequent commit that exposes both bugs.
Diffstat (limited to 'testsuite')
-rw-r--r--testsuite/tests/numeric/should_run/T19931.hs35
-rw-r--r--testsuite/tests/numeric/should_run/T19931.stdout1
-rw-r--r--testsuite/tests/numeric/should_run/all.T1
3 files changed, 37 insertions, 0 deletions
diff --git a/testsuite/tests/numeric/should_run/T19931.hs b/testsuite/tests/numeric/should_run/T19931.hs
new file mode 100644
index 0000000000..1ab9002d2e
--- /dev/null
+++ b/testsuite/tests/numeric/should_run/T19931.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Main where
+
+import GHC.Exts
+import GHC.Types
+import GHC.Num
+
+data T = T Word8#
+
+instance Num T where
+ fromInteger i = T (wordToWord8# (integerToWord# i))
+
+instance Eq T where
+ (==) (T a) (T b) = isTrue# (a `eqWord8#` b)
+ (/=) (T a) (T b) = isTrue# (a `neWord8#` b)
+
+main :: IO ()
+main = do
+ let !addr = "\0\1\2\3\4\5\6\7\8"#
+
+ w8 <- IO (\s -> case readWord8OffAddr# (plusAddr# addr 5#) 0# s of
+ (# s', w8 #) -> (# s', T w8 #))
+ -- w8 must be small enough for one of the branch to be taken.
+ -- we need several alternatives for a jump table to be used
+ print $ case w8 of
+ 0 -> 1000
+ 1 -> 1001
+ 2 -> 1002
+ 3 -> 1003
+ 4 -> 1004
+ 5 -> 1005
+ 6 -> 1006
+ _ -> 1010
diff --git a/testsuite/tests/numeric/should_run/T19931.stdout b/testsuite/tests/numeric/should_run/T19931.stdout
new file mode 100644
index 0000000000..49bc2728c7
--- /dev/null
+++ b/testsuite/tests/numeric/should_run/T19931.stdout
@@ -0,0 +1 @@
+1005
diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T
index 028677e52d..1123984bdd 100644
--- a/testsuite/tests/numeric/should_run/all.T
+++ b/testsuite/tests/numeric/should_run/all.T
@@ -74,5 +74,6 @@ test('T18499', normal, compile_and_run, [''])
test('T18509', normal, compile_and_run, [''])
test('T18515', normal, compile_and_run, [''])
test('T18604', normal, compile_and_run, [''])
+test('T19931', normal, compile_and_run, ['-O2'])
test('IntegerToFloat', normal, compile_and_run, [''])