Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/7d00c537d9ebf632ab93161171cced1ee386aa3e >--------------------------------------------------------------- commit 7d00c537d9ebf632ab93161171cced1ee386aa3e Author: Simon Peyton Jones <[email protected]> Date: Wed Aug 29 10:59:06 2012 +0100 Test Trac #7196 >--------------------------------------------------------------- tests/typecheck/should_compile/T7196.hs | 40 +++++++++++++++++++++++++++++++ tests/typecheck/should_compile/all.T | 1 + 2 files changed, 41 insertions(+), 0 deletions(-) diff --git a/tests/typecheck/should_compile/T7196.hs b/tests/typecheck/should_compile/T7196.hs new file mode 100644 index 0000000..29242b2 --- /dev/null +++ b/tests/typecheck/should_compile/T7196.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeFamilies #-} + +module Patch (qc_prim) where + +class PrimPatch (prim :: * -> * -> *) + +class PrimPatch (PrimOf p) => PrimPatchBase p where + type PrimOf (p :: * -> * -> *) :: * -> * -> * + +type TestGenerator thing gen = (forall t ctx . (forall xx yy . thing xx yy -> t) -> (gen ctx -> t)) + +type family ModelOf (patch :: * -> * -> *) :: * -> * + +data WithState s p x y = WithState { + _wsStartState :: s x + , _wsPatch :: p x y + , _wsEndState :: s y + } + +arbitraryThing :: x -> TestGenerator thing (thing x) +arbitraryThing _ f p = f p + +qc_prim :: forall prim x y . + (PrimPatch prim + , PrimOf prim ~ prim + ) => prim x y -> [()] +qc_prim _ = + concat + [ + patch_repo_properties (undefined :: prim x a) "arbitrary" arbitraryThing' + ] + where arbitraryThing' = arbitraryThing (undefined :: a) + +patch_repo_properties :: p x y -> String -> TestGenerator (WithState (ModelOf (PrimOf p)) p) gen -> [()] +patch_repo_properties _ _genname _gen = undefined + diff --git a/tests/typecheck/should_compile/all.T b/tests/typecheck/should_compile/all.T index 738e716..d5bedae 100644 --- a/tests/typecheck/should_compile/all.T +++ b/tests/typecheck/should_compile/all.T @@ -385,3 +385,4 @@ test('T7147', normal, compile, ['']) test('T7171',normal,run_command, ['$MAKE -s --no-print-directory T7171']) test('T7173', normal, compile, ['']) +test('T7196', normal, compile, ['']) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
