summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
authorAlexis King <lexi.lambda@gmail.com>2023-03-04 00:55:01 -0600
committerMarge Bot <ben+marge-bot@smart-cactus.org>2023-03-08 08:59:53 -0500
commitbed3a292df532935426987e1f0c5eaa4f605407e (patch)
tree06449c39b4e1712293d72884d99d191b46597225 /testsuite
parent1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2 (diff)
downloadhaskell-bed3a292df532935426987e1f0c5eaa4f605407e.tar.gz
bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args
fixes #23068
Diffstat (limited to 'testsuite')
-rw-r--r--testsuite/tests/bytecode/T23068.hs9
-rw-r--r--testsuite/tests/bytecode/T23068.script1
-rw-r--r--testsuite/tests/bytecode/T23068.stdout71
-rw-r--r--testsuite/tests/bytecode/all.T3
4 files changed, 84 insertions, 0 deletions
diff --git a/testsuite/tests/bytecode/T23068.hs b/testsuite/tests/bytecode/T23068.hs
new file mode 100644
index 0000000000..638327c361
--- /dev/null
+++ b/testsuite/tests/bytecode/T23068.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+module T23068 where
+import GHC.Exts
+
+f :: () -> (# Int, Int #)
+f () = (# 0, 0 #)
+
+g :: () -> (# Int#, Int#, Int #)
+g () = (# 0#, 0#, 0 #)
diff --git a/testsuite/tests/bytecode/T23068.script b/testsuite/tests/bytecode/T23068.script
new file mode 100644
index 0000000000..e89cf5e053
--- /dev/null
+++ b/testsuite/tests/bytecode/T23068.script
@@ -0,0 +1 @@
+:l T23068
diff --git a/testsuite/tests/bytecode/T23068.stdout b/testsuite/tests/bytecode/T23068.stdout
new file mode 100644
index 0000000000..86d2c9ddfc
--- /dev/null
+++ b/testsuite/tests/bytecode/T23068.stdout
@@ -0,0 +1,71 @@
+
+==================== Proto-BCOs ====================
+ProtoBCO T23068.g#1 []:
+ \r [ds] case of wild
+ bitmap: 1 [0]
+ PUSH_ALTS P
+ ProtoBCO wild#0 []:
+ { () -> let bcprep = ... in ...
+ bitmap: 1 [0]
+ ALLOC_PAP 1 0
+ PUSH_BCO
+ ProtoBCO bcprep#1 []:
+ \r [void] break<0>() let sat = ... in ...
+ bitmap: 0 []
+ BRK_FUN 0 <uniq> <cc>
+ PUSH_UBX (1) 0#
+ PACK GHC.Types.I# 1
+ PUSH_L 0
+ PUSH_UBX (1) 0#
+ PUSH_UBX (1) 0#
+ SLIDE 3 1
+ PUSH_UBX (1) 7##
+ PUSH_BCO
+ ProtoBCO tuple#0 []:
+ bitmap: 4 [7]
+ SLIDE 0 1
+ RETURN_TUPLE
+ RETURN_TUPLE
+ MKPAP 0 words, 1 stkoff
+ PUSH_APPLY_V
+ PUSH_L 1
+ SLIDE 2 5
+ ENTER
+ PUSH_L 2
+ ENTER
+
+ProtoBCO T23068.f#1 []:
+ \r [ds] case of wild
+ bitmap: 1 [0]
+ PUSH_ALTS P
+ ProtoBCO wild#0 []:
+ { () -> let bcprep = ... in ...
+ bitmap: 1 [0]
+ ALLOC_PAP 1 0
+ PUSH_BCO
+ ProtoBCO bcprep#1 []:
+ \r [void] break<1>() let sat = ... in ...
+ bitmap: 0 []
+ BRK_FUN 1 <uniq> <cc>
+ PUSH_UBX (1) 0#
+ PACK GHC.Types.I# 1
+ PUSH_UBX (1) 0#
+ PACK GHC.Types.I# 1
+ PUSH_LL 1 0
+ SLIDE 2 2
+ PUSH_UBX (1) 3##
+ PUSH_BCO
+ ProtoBCO tuple#0 []:
+ bitmap: 3 [1]
+ SLIDE 0 1
+ RETURN_TUPLE
+ RETURN_TUPLE
+ MKPAP 0 words, 1 stkoff
+ PUSH_APPLY_V
+ PUSH_L 1
+ SLIDE 2 5
+ ENTER
+ PUSH_L 2
+ ENTER
+
+
diff --git a/testsuite/tests/bytecode/all.T b/testsuite/tests/bytecode/all.T
new file mode 100644
index 0000000000..63ed3c19ce
--- /dev/null
+++ b/testsuite/tests/bytecode/all.T
@@ -0,0 +1,3 @@
+ghci_dump_bcos = [only_ways(['ghci']), extra_run_opts('-dno-typeable-binds -dsuppress-uniques -ddump-bcos')]
+
+test('T23068', ghci_dump_bcos + [filter_stdout_lines(r'.*bitmap: .*')], ghci_script, ['T23068.script'])