diff options
author | Andreas Klebinger <klebinger.andreas@gmx.at> | 2022-08-15 22:28:13 +0200 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2022-08-19 10:21:04 -0400 |
commit | 0868c8a544d81ac53fd9ebc53b99923b4b7c3b1f (patch) | |
tree | 074ce51b402bc8f8db628aeb6214c3dd04bba939 /testsuite | |
parent | ed84e10b0d2cf107a2858f1dfc0698d0e71bdd4f (diff) | |
download | haskell-0868c8a544d81ac53fd9ebc53b99923b4b7c3b1f.tar.gz |
Fix GHCis interaction with tag inference.
I had assumed that wrappers were not inlined in interactive mode.
Meaning we would always execute the compiled wrapper which properly
takes care of upholding the strict field invariant.
This turned out to be wrong. So instead we now run tag inference even
when we generate bytecode. In that case only for correctness not
performance reasons although it will be still beneficial for runtime
in some cases.
I further fixed a bug where GHCi didn't tag nullary constructors
properly when used as arguments. Which caused segfaults when calling
into compiled functions which expect the strict field invariant to
be upheld.
-------------------------
Metric Increase:
T4801
Metric Decrease:
T13035
-------------------------
Diffstat (limited to 'testsuite')
-rw-r--r-- | testsuite/tests/ghci.debugger/scripts/T12458.stdout | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci.debugger/scripts/print018.stdout | 6 | ||||
-rw-r--r-- | testsuite/tests/simplStg/should_run/Makefile | 9 | ||||
-rw-r--r-- | testsuite/tests/simplStg/should_run/T22042.hs | 6 | ||||
-rw-r--r-- | testsuite/tests/simplStg/should_run/T22042.stdout | 1 | ||||
-rw-r--r-- | testsuite/tests/simplStg/should_run/T22042a.hs | 10 | ||||
-rw-r--r-- | testsuite/tests/simplStg/should_run/all.T | 1 |
7 files changed, 31 insertions, 4 deletions
diff --git a/testsuite/tests/ghci.debugger/scripts/T12458.stdout b/testsuite/tests/ghci.debugger/scripts/T12458.stdout index 64c8134355..f5d42883f9 100644 --- a/testsuite/tests/ghci.debugger/scripts/T12458.stdout +++ b/testsuite/tests/ghci.debugger/scripts/T12458.stdout @@ -1,2 +1,2 @@ -d = (_t1::forall {k} {a :: k}. D a) +d = <D> () diff --git a/testsuite/tests/ghci.debugger/scripts/print018.stdout b/testsuite/tests/ghci.debugger/scripts/print018.stdout index e0ab829716..977d61cb7b 100644 --- a/testsuite/tests/ghci.debugger/scripts/print018.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print018.stdout @@ -1,9 +1,9 @@ Breakpoint 0 activated at Test.hs:40:10-17 Stopped in Test.Test2.poly, Test.hs:40:10-17 _result :: () = _ -x :: a = _ -x = (_t1::a) -x :: a +x :: Unary = Unary +x = Unary +x :: Unary () x = Unary x :: Unary diff --git a/testsuite/tests/simplStg/should_run/Makefile b/testsuite/tests/simplStg/should_run/Makefile index 9101fbd40a..03a3b5199e 100644 --- a/testsuite/tests/simplStg/should_run/Makefile +++ b/testsuite/tests/simplStg/should_run/Makefile @@ -1,3 +1,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T22042: T22042_clean + "$(TEST_HC)" $(TEST_HC_OPTS) -O T22042a.hs -dynamic -c + "$(TEST_HC)" $(TEST_HC_OPTS) -e ":main" T22042.hs T22042a.o + +T22042_clean: + rm -f T22042a.o T22042a.hi + +.PHONY: T22042 T22042_clean diff --git a/testsuite/tests/simplStg/should_run/T22042.hs b/testsuite/tests/simplStg/should_run/T22042.hs new file mode 100644 index 0000000000..45f1ec1936 --- /dev/null +++ b/testsuite/tests/simplStg/should_run/T22042.hs @@ -0,0 +1,6 @@ +module Main where + +import T22042a + +main = do + putStrLn (foo $ SC A B C) diff --git a/testsuite/tests/simplStg/should_run/T22042.stdout b/testsuite/tests/simplStg/should_run/T22042.stdout new file mode 100644 index 0000000000..5da849b5c6 --- /dev/null +++ b/testsuite/tests/simplStg/should_run/T22042.stdout @@ -0,0 +1 @@ +ABC diff --git a/testsuite/tests/simplStg/should_run/T22042a.hs b/testsuite/tests/simplStg/should_run/T22042a.hs new file mode 100644 index 0000000000..41d412f120 --- /dev/null +++ b/testsuite/tests/simplStg/should_run/T22042a.hs @@ -0,0 +1,10 @@ +module T22042a where + +data A = A | AA deriving Show +data B = B | AB deriving Show +data C = C | AC deriving Show + +data SC = SC !A !B !C + +foo :: SC -> String +foo (SC a b c) = show a ++ show b ++ show c diff --git a/testsuite/tests/simplStg/should_run/all.T b/testsuite/tests/simplStg/should_run/all.T index 1d017043d6..d5d40cc237 100644 --- a/testsuite/tests/simplStg/should_run/all.T +++ b/testsuite/tests/simplStg/should_run/all.T @@ -19,3 +19,4 @@ test('T13536a', ['']) test('inferTags001', normal, multimod_compile_and_run, ['inferTags001', 'inferTags001_a']) +test('T22042', [extra_files(['T22042a.hs']),only_ways('normal'),unless(have_dynamic(), skip)], makefile_test, ['T22042']) |