Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/8b971c7b9944465d9fd9b82ed7f3766fd76fef2e >--------------------------------------------------------------- commit 8b971c7b9944465d9fd9b82ed7f3766fd76fef2e Author: Simon Peyton Jones <[email protected]> Date: Thu Sep 8 21:36:42 2011 +0100 Test Trac #5441 >--------------------------------------------------------------- tests/simplCore/should_run/T5441.hs | 5 +++ .../should_run/T5441.stdout} | 0 tests/simplCore/should_run/T5441a.hs | 39 ++++++++++++++++++++ tests/simplCore/should_run/all.T | 2 + 4 files changed, 46 insertions(+), 0 deletions(-) diff --git a/tests/simplCore/should_run/T5441.hs b/tests/simplCore/should_run/T5441.hs new file mode 100644 index 0000000..0ab113d --- /dev/null +++ b/tests/simplCore/should_run/T5441.hs @@ -0,0 +1,5 @@ +module Main where + +import T5441a + +main = putStrLn (showNat Z) diff --git a/tests/codeGen/should_run/2838.stdout b/tests/simplCore/should_run/T5441.stdout similarity index 66% copy from tests/codeGen/should_run/2838.stdout copy to tests/simplCore/should_run/T5441.stdout index 573541a..1874828 100644 diff --git a/tests/simplCore/should_run/T5441a.hs b/tests/simplCore/should_run/T5441a.hs new file mode 100644 index 0000000..4c6668b --- /dev/null +++ b/tests/simplCore/should_run/T5441a.hs @@ -0,0 +1,39 @@ +module T5441a where + +import Unsafe.Coerce (unsafeCoerce) +import GHC.Prim (Any) + +listmap :: (a -> b) -> [a] -> [b] +listmap f [] = [] +listmap f (x : xs) = f x : listmap f xs + +data Nat = Z | S Nat + +{-# NOINLINE inject #-} +inject :: Nat -> Nat -> Nat +inject m i = i + +{-# NOINLINE look #-} +look :: Nat -> String -> Char +look Z _ = '0' + +showDigit :: Nat -> () -> Nat -> Char +showDigit base prf d = look (inject base d) "" + +toDigits :: Nat -> Nat -> [Nat] +toDigits Z Z = [Z] + +coe1 :: (Nat -> String) -> Any +coe1 = unsafeCoerce + +coe2 :: Any -> (Nat -> String) +coe2 = unsafeCoerce + +showInBase :: Nat -> Any +showInBase base + = coe1 (\n -> listmap + (showDigit base ()) + (toDigits base n)) + +showNat :: Nat -> String +showNat = coe2 (showInBase Z) diff --git a/tests/simplCore/should_run/all.T b/tests/simplCore/should_run/all.T index a78db43..25338d1 100644 --- a/tests/simplCore/should_run/all.T +++ b/tests/simplCore/should_run/all.T @@ -46,3 +46,5 @@ test('T3972', extra_clean(['T3972A.hi', 'T3972A.o']), ['']) test('T5315', normal, compile_and_run, ['']) test('T5453', normal, compile_and_run, ['']) +test('T5441', extra_clean(['T5441a.o','T5441a.hi']), + multimod_compile_and_run, ['T5441','']) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
