[Git][ghc/ghc][master] testsuite: Add test for #18346

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
ee5dcdf9 by Ben Gamari at 2020-10-20T00:47:54-04:00
testsuite: Add test for #18346

This was fixed by 4291bddaea3148908c55f235ee8978e1d9aa6f20.

- - - - -


3 changed files:

- + testsuite/tests/simplCore/should_compile/T18346/MiniLens.hs
- + testsuite/tests/simplCore/should_compile/T18346/T18346.hs
- + testsuite/tests/simplCore/should_compile/T18346/all.T


Changes:

=====================================
testsuite/tests/simplCore/should_compile/T18346/MiniLens.hs
=====================================
@@ -0,0 +1,23 @@
+{-# LANGUAGE RankNTypes #-}
+
+module MiniLens ((^.), Getting, Lens', lens, view) where
+
+import Data.Functor.Const (Const(..))
+
+type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
+
+type Lens' s a = Lens s s a a
+
+lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
+lens sa sbt afb s = sbt s <$> afb (sa s)
+{-# INLINE lens #-}
+
+type Getting r s a = (a -> Const r a) -> s -> Const r s
+
+view :: Getting a s a -> s -> a
+view l = getConst . l Const
+{-# INLINE view #-}
+
+(^.) :: s -> Getting a s a -> a
+s ^. l = getConst (l Const s)
+{-# INLINE (^.) #-}


=====================================
testsuite/tests/simplCore/should_compile/T18346/T18346.hs
=====================================
@@ -0,0 +1,18 @@
+{-# LANGUAGE RankNTypes #-}
+
+module GHCBug (field) where
+
+import MiniLens ((^.), Getting, Lens', lens, view)
+
+t' :: Getting () () ()
+t' = lens id const
+{-# NOINLINE t' #-}
+
+mlift :: Functor f => Getting b a b -> Lens' (f a) (f b)
+mlift l = lens (fmap (^. l)) const
+{-# INLINE mlift #-}
+
+newtype Field = F (Maybe () -> Maybe ())
+
+field :: Field
+field = F (view (mlift t'))


=====================================
testsuite/tests/simplCore/should_compile/T18346/all.T
=====================================
@@ -0,0 +1,2 @@
+test('T18346', [extra_files(['MiniLens.hs'])], multimod_compile, ['T18346.hs', '-v0'])
+



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee5dcdf95a7c408e9c339aacebf89a007a735f8f

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee5dcdf95a7c408e9c339aacebf89a007a735f8f
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201020/5d0cd93b/attachment-0001.html>