Test Trac #5441
authorSimon Peyton Jones <simonpj@microsoft.com>
Thu, 8 Sep 2011 20:36:42 +0000 (21:36 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Thu, 8 Sep 2011 20:36:42 +0000 (21:36 +0100)
testsuite/tests/simplCore/should_run/T5441.hs [new file with mode: 0644]
testsuite/tests/simplCore/should_run/T5441.stdout [new file with mode: 0644]
testsuite/tests/simplCore/should_run/T5441a.hs [new file with mode: 0644]
testsuite/tests/simplCore/should_run/all.T

diff --git a/testsuite/tests/simplCore/should_run/T5441.hs b/testsuite/tests/simplCore/should_run/T5441.hs
new file mode 100644 (file)
index 0000000..0ab113d
--- /dev/null
@@ -0,0 +1,5 @@
+module Main where\r
+\r
+import T5441a\r
+\r
+main = putStrLn (showNat Z)\r
diff --git a/testsuite/tests/simplCore/should_run/T5441.stdout b/testsuite/tests/simplCore/should_run/T5441.stdout
new file mode 100644 (file)
index 0000000..1874828
--- /dev/null
@@ -0,0 +1 @@
+0\r
diff --git a/testsuite/tests/simplCore/should_run/T5441a.hs b/testsuite/tests/simplCore/should_run/T5441a.hs
new file mode 100644 (file)
index 0000000..4c6668b
--- /dev/null
@@ -0,0 +1,39 @@
+module T5441a where\r
+\r
+import Unsafe.Coerce (unsafeCoerce)\r
+import GHC.Prim (Any)\r
+\r
+listmap :: (a -> b) -> [a] -> [b]\r
+listmap f []       = []\r
+listmap f (x : xs) = f x : listmap f xs\r
+\r
+data Nat = Z | S Nat\r
+\r
+{-# NOINLINE inject #-}\r
+inject :: Nat -> Nat -> Nat\r
+inject m i = i\r
+\r
+{-# NOINLINE look #-}\r
+look :: Nat -> String -> Char\r
+look Z _ = '0'\r
+\r
+showDigit :: Nat -> () -> Nat -> Char\r
+showDigit base prf d = look (inject base d) ""\r
+\r
+toDigits :: Nat -> Nat -> [Nat]\r
+toDigits Z Z = [Z]\r
+\r
+coe1 :: (Nat -> String) -> Any\r
+coe1 = unsafeCoerce\r
+\r
+coe2 :: Any -> (Nat -> String)\r
+coe2 = unsafeCoerce\r
+\r
+showInBase :: Nat -> Any\r
+showInBase base\r
+  = coe1 (\n -> listmap\r
+                (showDigit base ())\r
+                (toDigits base n))\r
+\r
+showNat :: Nat -> String\r
+showNat = coe2 (showInBase Z)\r
index a78db43..25338d1 100644 (file)
@@ -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',''])