diff options
author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2021-02-07 20:12:59 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-02-13 21:31:22 -0500 |
commit | 18e5338671518d060006010ebb796df265cb52e3 (patch) | |
tree | e0380987136ba493b25390f4286592f50aac3178 /testsuite | |
parent | a6c3ddfe388f971ccaec28b43bccbd82a81e83ba (diff) | |
download | haskell-18e5338671518d060006010ebb796df265cb52e3.tar.gz |
Add tests for solved arrow tickets #5777 #15175
Merge requests !4464 and !4474 fixed the Lint problems.
Closes #5777.
Closes #15175.
Diffstat (limited to 'testsuite')
-rw-r--r-- | testsuite/tests/arrows/should_compile/T15175.hs | 64 | ||||
-rw-r--r-- | testsuite/tests/arrows/should_compile/T5777.hs | 13 | ||||
-rw-r--r-- | testsuite/tests/arrows/should_compile/all.T | 2 |
3 files changed, 79 insertions, 0 deletions
diff --git a/testsuite/tests/arrows/should_compile/T15175.hs b/testsuite/tests/arrows/should_compile/T15175.hs new file mode 100644 index 0000000000..af396dfa95 --- /dev/null +++ b/testsuite/tests/arrows/should_compile/T15175.hs @@ -0,0 +1,64 @@ +{-# OPTIONS_GHC -Wno-missing-methods #-} +{-# LANGUAGE Arrows #-} +{-# LANGUAGE GADTs #-} + +module T15175 ( + gun, -- :: Position2 -> Object +) where + +import Control.Arrow +import Control.Category (Category) + +data Point2 a = RealFloat a => Point2 !a !a + +gun :: Point2 Double -> Object +gun (Point2 x0 y0) = proc (ObjInput {oiGameInput = gi}) -> do + (Point2 xd _) <- ptrPos -< gi -- This line can't be removed + + let x = undefined + v = undefined + fire = undefined :: Double + + returnA -< ObjOutput { + ooSpawnReq = + fire `tag` [missile (Point2 x (y0 + (0/2))) + (vector2 v (200 :: Double))] + } + +vector2 = undefined + +tag = undefined + +ptrPos = undefined + +missile = undefined + +-- | Creates a feedback loop without delay. +instance Category SF where + +instance ArrowLoop SF where + +instance Arrow SF where + +data SF' a b where + SF' :: !(DTime -> a -> Transition a b) -> SF' a b + +type Transition a b = (SF' a b, b) + +data SF a b = SF {sfTF :: a -> Transition a b} + +type DTime = Double -- [s] + +data Event a = Event a deriving (Show) + +type Object = SF ObjInput ObjOutput + +data ObjInput = ObjInput { + oiGameInput :: GameInput +} + +data ObjOutput = ObjOutput { + ooSpawnReq :: Event [Object] +} + +data GameInput = GameInput diff --git a/testsuite/tests/arrows/should_compile/T5777.hs b/testsuite/tests/arrows/should_compile/T5777.hs new file mode 100644 index 0000000000..697473a4a4 --- /dev/null +++ b/testsuite/tests/arrows/should_compile/T5777.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE Arrows, GADTs #-} +module T5777 where + +import Control.Arrow + +data Value a where BoolVal :: Value Bool + +class ArrowInit f where + arrif :: f b -> () + +instance ArrowInit Value where + arrif = proc BoolVal -> returnA -< () + -- arrif = arr (\BoolVal -> ()) diff --git a/testsuite/tests/arrows/should_compile/all.T b/testsuite/tests/arrows/should_compile/all.T index a399006aae..f636903a0a 100644 --- a/testsuite/tests/arrows/should_compile/all.T +++ b/testsuite/tests/arrows/should_compile/all.T @@ -18,3 +18,5 @@ test('T5022', normalise_fun(normalise_errmsg), compile, ['']) test('T5333', normal, compile, ['']) test('T17423', normal, compile, ['']) test('T18950', normal, compile, ['']) +test('T5777', normal, compile, ['']) +test('T15175', normal, compile, ['']) |