diff options
author | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-08-22 09:28:43 -0400 |
---|---|---|
committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-08-22 09:28:43 -0400 |
commit | 6982ee99fb97c252c3faf37faae34131fb66f67c (patch) | |
tree | f5e51de2aa47121e8c600c0e8875aa6214374873 /testsuite/tests | |
parent | 34bd43d9c24207a1897aaa4ee6cb70592a3f7acc (diff) | |
download | haskell-6982ee99fb97c252c3faf37faae34131fb66f67c.tar.gz |
Fix #14125 by normalizing data family instances more aggressively
Summary:
Commit 3540d1e1a23926ce0a8a6ae83a36f5f6b2497ccf inadvertently broke
the ability for newtype instances to be used as marshallable types in FFI
declarations. The reason is a bit silly: an extra check was added for type
synonyms with no type families on the RHS in `normalise_tc_app`, but this check
would only skip over type families, not //data// families, since the predicate
being used was `not . isTypeFamilyCon`.
The fix is simple: just use `not . isFamilyCon` instead so that data families
are also skipped by this check.
Test Plan: make test TEST=T14125
Reviewers: goldfire, simonpj, austin, bgamari
Reviewed By: simonpj
Subscribers: rwbarton, thomie
GHC Trac Issues: #14125
Differential Revision: https://phabricator.haskell.org/D3865
Diffstat (limited to 'testsuite/tests')
-rw-r--r-- | testsuite/tests/ffi/should_compile/T14125.hs | 17 | ||||
-rw-r--r-- | testsuite/tests/ffi/should_compile/all.T | 1 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/T14125a.script | 8 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/T14125a.stdout | 5 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/all.T | 3 |
5 files changed, 33 insertions, 1 deletions
diff --git a/testsuite/tests/ffi/should_compile/T14125.hs b/testsuite/tests/ffi/should_compile/T14125.hs new file mode 100644 index 0000000000..daf236d5ca --- /dev/null +++ b/testsuite/tests/ffi/should_compile/T14125.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE TypeFamilies #-} +module T14125 where + +import Foreign.C.String +import Foreign.C.Types + +data UnixReturn + +data family IOErrno a +newtype instance IOErrno UnixReturn = UnixErrno CInt + +foreign import ccall unsafe "string.h" + strerror :: IOErrno UnixReturn -> IO CString + +foreign import ccall unsafe "HsBase.h __hscore_get_errno" + get_errno :: IO (IOErrno UnixReturn) diff --git a/testsuite/tests/ffi/should_compile/all.T b/testsuite/tests/ffi/should_compile/all.T index 18192d49ff..0f2f3901c4 100644 --- a/testsuite/tests/ffi/should_compile/all.T +++ b/testsuite/tests/ffi/should_compile/all.T @@ -31,3 +31,4 @@ test('cc015', normal, compile, ['']) test('cc016', normal, compile, ['']) test('T10460', normal, compile, ['']) test('T11983', [omit_ways(['ghci'])], compile, ['T11983.c']) +test('T14125', normal, compile, ['']) diff --git a/testsuite/tests/ghci/should_run/T14125a.script b/testsuite/tests/ghci/should_run/T14125a.script new file mode 100644 index 0000000000..1667349160 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14125a.script @@ -0,0 +1,8 @@ +:set -XTypeFamilies +data family Foo a +data instance Foo Int = FooInt Int +:kind! Foo Int +let f (FooInt i) = i +:info f +:type +v f +:type f diff --git a/testsuite/tests/ghci/should_run/T14125a.stdout b/testsuite/tests/ghci/should_run/T14125a.stdout new file mode 100644 index 0000000000..7b4e85edd3 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14125a.stdout @@ -0,0 +1,5 @@ +Foo Int :: * += Foo Int +f :: Foo Int -> Int -- Defined at <interactive>:5:5 +f :: Foo Int -> Int +f :: Foo Int -> Int diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index fe33685193..da20149b56 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -27,4 +27,5 @@ test('T11825', just_ghci, ghci_script, ['T11825.script']) test('T12128', just_ghci, ghci_script, ['T12128.script']) test('T12456', just_ghci, ghci_script, ['T12456.script']) test('T12549', just_ghci, ghci_script, ['T12549.script']) -test('BinaryArray', normal, compile_and_run, [''])
\ No newline at end of file +test('BinaryArray', normal, compile_and_run, ['']) +test('T14125a', just_ghci, ghci_script, ['T14125a.script']) |