From 59f4cb6fb73ade6f9b0bdc85380dfddba93bf14b Mon Sep 17 00:00:00 2001
From: Iavor Diatchki <iavor.diatchki@gmail.com>
Date: Tue, 7 May 2019 13:02:27 -0700
Subject: Add a `NOINLINE` pragma on `someNatVal` (#16586)

This fixes #16586, see `Note [NOINLINE someNatVal]` for details.
---
 testsuite/tests/lib/base/T16586.hs     | 27 +++++++++++++++++++++++++++
 testsuite/tests/lib/base/T16586.stdout |  1 +
 testsuite/tests/lib/base/all.T         |  1 +
 3 files changed, 29 insertions(+)
 create mode 100644 testsuite/tests/lib/base/T16586.hs
 create mode 100644 testsuite/tests/lib/base/T16586.stdout
 create mode 100644 testsuite/tests/lib/base/all.T

(limited to 'testsuite/tests')

diff --git a/testsuite/tests/lib/base/T16586.hs b/testsuite/tests/lib/base/T16586.hs
new file mode 100644
index 0000000000..37169e650a
--- /dev/null
+++ b/testsuite/tests/lib/base/T16586.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE DataKinds, PolyKinds, RankNTypes, ScopedTypeVariables #-}
+
+module Main where
+
+import Data.Proxy
+import GHC.TypeNats
+import Numeric.Natural
+
+newtype Foo (m :: Nat) = Foo { getVal :: Word }
+
+mul :: KnownNat m => Foo m -> Foo m -> Foo m
+mul mx@(Foo x) (Foo y) =
+  Foo $ x * y `rem` fromIntegral (natVal mx)
+
+pow :: KnownNat m => Foo m -> Int -> Foo m
+pow x k = iterate (`mul` x) (Foo 1) !! k
+
+modl :: (forall m. KnownNat m => Foo m) -> Natural -> Word
+modl x m = case someNatVal m of
+  SomeNat (_ :: Proxy m) -> getVal (x :: Foo m)
+
+-- Should print 1
+main :: IO ()
+main = print $ (Foo 127 `pow` 31336) `modl` 31337
+
+dummyValue :: Word
+dummyValue = (Foo 33 `pow` 44) `modl` 456
diff --git a/testsuite/tests/lib/base/T16586.stdout b/testsuite/tests/lib/base/T16586.stdout
new file mode 100644
index 0000000000..d00491fd7e
--- /dev/null
+++ b/testsuite/tests/lib/base/T16586.stdout
@@ -0,0 +1 @@
+1
diff --git a/testsuite/tests/lib/base/all.T b/testsuite/tests/lib/base/all.T
new file mode 100644
index 0000000000..ff0c9f963f
--- /dev/null
+++ b/testsuite/tests/lib/base/all.T
@@ -0,0 +1 @@
+test('T16586', normal, compile_and_run, ['-O2'])
-- 
cgit v1.2.1