Skip to content
Snippets Groups Projects
Commit def47dd3 authored by Ben Gamari's avatar Ben Gamari Committed by Marge Bot
Browse files

testsuite: Don't use grep -q in unpack_sums_7

`grep -q` closes stdin as soon as it finds the pattern it is looking
for, resulting in #22484.
parent ab23dc5e
No related branches found
No related tags found
No related merge requests found
......@@ -6,6 +6,6 @@ include $(TOP)/mk/test.mk
unpack_sums_7:
$(RM) -f unpack_sums_7.o unpack_sums_7.hi
'$(TEST_HC)' $(TEST_HC_OPTS) -c unpack_sums_7.hs -O -dsuppress-all -ddump-simpl | grep -q '\(# |_ #\)'
'$(TEST_HC)' $(TEST_HC_OPTS) -c unpack_sums_7.hs -O -dsuppress-all -dsuppress-uniques -ddump-simpl | grep '\(# |_ #\)'
# This is a test to check for the presence of an unboxed sum in the core for a program using UNPACK
# on a sum type which is evidence that the field has been correctly unpacked.
......@@ -46,7 +46,7 @@ test('unpack_sums_3', normal, compile_and_run, ['-O'])
test('unpack_sums_4', normal, compile_and_run, ['-O'])
test('unpack_sums_5', normal, compile, ['-O'])
test('unpack_sums_6', fragile(22504), compile_and_run, ['-O'])
test('unpack_sums_7', [], makefile_test, [])
test('unpack_sums_7', normal, makefile_test, [])
test('unpack_sums_8', normal, compile_and_run, [""])
test('unpack_sums_9', normal, compile, [""])
......
-- NB: Compiling this module throws an exception involving Weak# at the end of compilation.
-- This is unrelated to unpacked sums but we need to include the error in the expected output for the test to pass.
module UnpackedSums7 where
data T = MkT {-# UNPACK #-} !MI
......
Exception during Weak# finalization (ignored): <stdout>: hFlush: resource vanished (Broken pipe)
Exception during Weak# finalization (ignored): <stdout>: hFlush: resource vanished (Broken pipe)
JI unbx -> (# |_ #) unbx
t = MkT ((# |_ #) t1)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment