diff options
author | Ben Gamari <ben@smart-cactus.org> | 2022-04-14 14:51:07 -0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-04-15 13:56:34 -0400 |
commit | 96b9e5ea93f7a70b6481182652e4433f53cd244b (patch) | |
tree | 3794c2c998fd0a2e6d80ca479a756610a18d97c1 | |
parent | 7c639b9a589f7e937f2343ae4bdfea2ba5b1f74b (diff) | |
download | haskell-96b9e5ea93f7a70b6481182652e4433f53cd244b.tar.gz |
testsuite: Add test for #21390
-rw-r--r-- | testsuite/tests/ghci/T21390/GetTy.hs | 9 | ||||
-rw-r--r-- | testsuite/tests/ghci/T21390/Lib.hs | 7 | ||||
-rw-r--r-- | testsuite/tests/ghci/T21390/T21390.script | 4 | ||||
-rw-r--r-- | testsuite/tests/ghci/T21390/T21390.stdout | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci/T21390/Test.hs | 8 | ||||
-rw-r--r-- | testsuite/tests/ghci/T21390/all.T | 14 |
6 files changed, 44 insertions, 0 deletions
diff --git a/testsuite/tests/ghci/T21390/GetTy.hs b/testsuite/tests/ghci/T21390/GetTy.hs new file mode 100644 index 0000000000..e52fbd95f5 --- /dev/null +++ b/testsuite/tests/ghci/T21390/GetTy.hs @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fobject-code #-} + +module GetTy (getTy) where + +import Lib + +getTy :: Ty -> Int +getTy (Ty (Just n)) = n +getTy (Ty Nothing) = error "uh oh" diff --git a/testsuite/tests/ghci/T21390/Lib.hs b/testsuite/tests/ghci/T21390/Lib.hs new file mode 100644 index 0000000000..5969de3c55 --- /dev/null +++ b/testsuite/tests/ghci/T21390/Lib.hs @@ -0,0 +1,7 @@ +{-# OPTIONS_GHC -O0 -fobject-code #-} + +module Lib (Ty(..)) where + +-- We need to ensure that this *isn't* unpacked. +data Ty = Ty {-# NOUNPACK #-} !(Maybe Int) + diff --git a/testsuite/tests/ghci/T21390/T21390.script b/testsuite/tests/ghci/T21390/T21390.script new file mode 100644 index 0000000000..2d84180c54 --- /dev/null +++ b/testsuite/tests/ghci/T21390/T21390.script @@ -0,0 +1,4 @@ +:load Test.hs GetTy.hs +import GetTy +import Test +getTy (mkTy 1) diff --git a/testsuite/tests/ghci/T21390/T21390.stdout b/testsuite/tests/ghci/T21390/T21390.stdout new file mode 100644 index 0000000000..9a7456b54d --- /dev/null +++ b/testsuite/tests/ghci/T21390/T21390.stdout @@ -0,0 +1,2 @@ +2 + diff --git a/testsuite/tests/ghci/T21390/Test.hs b/testsuite/tests/ghci/T21390/Test.hs new file mode 100644 index 0000000000..692eac1555 --- /dev/null +++ b/testsuite/tests/ghci/T21390/Test.hs @@ -0,0 +1,8 @@ +module Test (mkTy) where + +import Lib + +-- The bytecode interpreter will fail to tag the Just correctly here. +mkTy :: Int -> Ty +mkTy n = Ty (Just (n+1)) + diff --git a/testsuite/tests/ghci/T21390/all.T b/testsuite/tests/ghci/T21390/all.T new file mode 100644 index 0000000000..9f62cc8715 --- /dev/null +++ b/testsuite/tests/ghci/T21390/all.T @@ -0,0 +1,14 @@ +# This tests #21390, where data constructors constructed by the interpreter +# would contain untagged values in strict fields. +# +# The test is structured as follows: +# +# * `Lib.hs` defines a type defining `Ty`, a type with a strict Maybe field; +# this should be compiled to object code +# * `GetTy.hs` defines a function, `getTy`, which scrutinizes a `Ty` value and +# its field. This too should be compiled to object code. +# * `Test.hs` defines `mkTy` which constructs a `Ty`. This should be +# interpreted. + +test('T21390', extra_files(['Lib.hs', 'Test.hs', 'GetTy.hs']), ghci_script, ['T21390.script']) + |