testsuite/tests/quotes/T20472_quotes.hs

+{-# LANGUAGE TemplateHaskellQuotes #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# OPTIONS_GHC -fdefer-out-of-scope-variables #-}
+module T20472_quotes where
+
+foo = [| Prelude.a |]

testsuite/tests/quotes/all.T

@@ -41,3 +41,4 @@ test('TH_double_splice', normal, compile_fail, [''])
 test('T20688', normal, compile, ['-Wimplicit-lift -Werror'])
 test('T20893', normal, compile_and_run, [''])
 test('T21619', normal, compile, [''])
+test('T20472_quotes', normal, compile, [''])

testsuite/tests/rename/should_compile/T20472.stderr

@@ -3,7 +3,9 @@ T20472.hs:5:5: warning: [GHC-88464] [-Wdeferred-out-of-scope-variables (in -Wdef
     Variable not in scope: nonexistent
 
 T20472.hs:6:5: warning: [GHC-88464] [-Wdeferred-out-of-scope-variables (in -Wdefault)]
-    Variable not in scope: nonexistent
+    Variable not in scope: Prelude.nonexistent
+    NB: the module ‘Prelude’ does not export ‘nonexistent’.
 
 T20472.hs:8:5: warning: [GHC-88464] [-Wdeferred-out-of-scope-variables (in -Wdefault)]
-    Variable not in scope: x
+    Variable not in scope: Nonexistent.x
+    NB: no module named ‘Nonexistent’ is imported.

testsuite/tests/rts/T13894.hs

--- Test that isByteArray# returns True for large but not explicitly pinned byte
--- arrays
+-- Test that isByteArray# returns False for large but not explicitly pinned byte
+-- arrays, see #22255
 
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE UnboxedTuples  #-}
@@ -15,4 +15,4 @@ main = do
         (# s1, arr# #) ->
             case isMutableByteArrayPinned# arr# of
               n# -> (# s1, isTrue# n# #)
-    unless pinned $ putStrLn "BAD"
+    when pinned $ putStrLn "BAD"

testsuite/tests/rts/T14900.hs

@@ -13,6 +13,8 @@ newByteArray (I# sz) = IO $ \s -> case newByteArray# sz s of {
   (# s', arr# #) -> case unsafeFreezeByteArray# arr# s of {
   (# s'', barr# #) -> (# s', ByteArray barr# #) }}
 
+-- Currently we expect large/compact regions not to count as pinned.
+-- See #22255 for the reasoning.
 main :: IO ()
 main = do
   ByteArray arr1# <- fmap getCompact $ newByteArray 65000 >>= compact

testsuite/tests/rts/T14900.stdout

-1
-1
+0
+0
 Finished

testsuite/tests/simplCore/should_compile/T22634.hs

+module T226334 where
+
+import Data.Kind
+import Type.Reflection
+
+fromDynamic :: forall (a :: Type) (b :: Type). Typeable a => TypeRep b -> Maybe (a :~~: b)
+fromDynamic t = typeRep `eqTypeRep` t
+
+recursiveStrategy :: forall (a :: Type) (b :: Type). Typeable a
+                  => TypeRep b -> Maybe ((Bool -> a) :~~: b)
+recursiveStrategy = fromDynamic

testsuite/tests/simplCore/should_compile/all.T

@@ -454,6 +454,7 @@ test('T21851_2', [grep_errmsg(r'wwombat') ], multimod_compile, ['T21851_2', '-O
 # Should not inline m, so there shouldn't be a single YES
 test('T22317', [grep_errmsg(r'ANSWER = YES') ], compile, ['-O -dinline-check m -ddebug-output'])
 
+test('T22634', normal, compile, ['-O -fcatch-nonexhaustive-cases'])
 test('T22494', [grep_errmsg(r'case') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
 test('T22491', normal, compile, ['-O2'])
 test('T21476', normal, compile, [''])

testsuite/tests/typecheck/should_compile/T22647.hs

+{-# LANGUAGE TypeApplications, KindSignatures, DataKinds, TypeFamilies, FlexibleInstances #-}
+
+module T22647 where
+
+import Data.Kind
+
+data D = D
+type family F :: D -> Type
+
+class C f where
+  meth :: f
+
+instance C (f (p :: D)) where   -- f :: D -> Type
+  meth = error "urk1"
+
+instance C (g (q :: Type)) where -- g :: Type -> Type
+  meth = error "urk2"
+
+x = meth :: F 'D
+
+y = meth :: [Type]

testsuite/tests/typecheck/should_compile/all.T

@@ -853,3 +853,4 @@ test('T21550', normal, compile, [''])
 test('T22310', normal, compile, [''])
 test('T22331', normal, compile, [''])
 test('T22516', normal, compile, [''])
+test('T22647', normal, compile, [''])

utils/check-exact/ExactPrint.hs

@@ -114,6 +114,7 @@ defaultEPState = EPState
              , uExtraDP = Nothing
              , epComments = []
              , epCommentsApplied = []
+             , epEof = Nothing
              }
 
 
@@ -188,6 +189,7 @@ data EPState = EPState
              -- Shared
              , epComments :: ![Comment]
              , epCommentsApplied :: ![[Comment]]
+             , epEof :: !(Maybe (RealSrcSpan, RealSrcSpan))
              }
 
 -- ---------------------------------------------------------------------
@@ -238,11 +240,7 @@ instance HasEntry (EpAnn a) where
 fromAnn' :: (HasEntry a) => a -> Entry
 fromAnn' an = case fromAnn an of
   NoEntryVal -> NoEntryVal
-  Entry a c _ u -> Entry a c' FlushComments u
-    where
-      c' = case c of
-        EpaComments cs -> EpaCommentsBalanced (filterEofComment False cs) (filterEofComment True cs)
-        EpaCommentsBalanced cp ct -> EpaCommentsBalanced cp ct
+  Entry a c _ u -> Entry a c FlushComments u
 
 -- ---------------------------------------------------------------------
 
@@ -355,7 +353,7 @@ enterAnn (Entry anchor' cs flush canUpdateAnchor) a = do
 
   let mflush = when (flush == FlushComments) $ do
         debugM $ "flushing comments in enterAnn:" ++ showAst cs
-        flushComments (getFollowingComments cs ++ filterEofComment True (priorComments cs))
+        flushComments (getFollowingComments cs)
 
   advance edp
   a' <- exact a
@@ -369,6 +367,17 @@ enterAnn (Entry anchor' cs flush canUpdateAnchor) a = do
       mapM_ printOneComment (map tokComment $ getFollowingComments cs)
       debugM $ "ending trailing comments"
 
+  eof <- getEofPos
+  case eof of
+    Nothing -> return ()
+    Just (pos, prior) -> do
+       let dp = if pos == prior
+             then (DifferentLine 1 0)
+             else origDelta pos prior
+       debugM $ "EOF:(pos,prior,dp) =" ++ showGhc (ss2pos pos, ss2pos prior, dp)
+       printStringAtLsDelta dp ""
+       setEofPos Nothing -- Only do this once
+
   let newAchor = anchor' { anchor_op = MovedAnchor edp }
   let r = case canUpdateAnchor of
             CanUpdateAnchor -> setAnnotationAnchor a' newAchor (mkEpaComments (priorCs++ postCs) [])
@@ -413,23 +422,12 @@ addComments csNew = do
 -- ones in the state.
 flushComments :: (Monad m, Monoid w) => [LEpaComment] -> EP w m ()
 flushComments trailing = do
-  addCommentsA (filterEofComment False trailing)
+  addCommentsA trailing
   cs <- getUnallocatedComments
   debugM $ "flushing comments starting"
   mapM_ printOneComment (sortComments cs)
-  debugM $ "flushing comments:EOF:trailing:" ++ showAst (trailing)
-  debugM $ "flushing comments:EOF:" ++ showAst (filterEofComment True trailing)
-  mapM_ printOneComment (map tokComment (filterEofComment True trailing))
   debugM $ "flushing comments done"
 
-filterEofComment :: Bool -> [LEpaComment] -> [LEpaComment]
-filterEofComment keep cs = fixCs cs
-  where
-      notEof com = case com of
-       L _ (GHC.EpaComment (EpaEofComment) _) -> keep
-       _ -> not keep
-      fixCs c = filter notEof c
-
 -- ---------------------------------------------------------------------
 
 -- |In order to interleave annotations into the stream, we turn them into
@@ -1397,6 +1395,13 @@ instance ExactPrint (HsModule GhcPs) where
           EpAnnNotUsed -> (am_decls $ anns an0)
           EpAnn _ r _ -> r
 
+    -- Print EOF
+    case am_eof $ anns an of
+      Nothing -> return ()
+      Just (pos, prior) -> do
+        debugM $ "am_eof:" ++ showGhc (pos, prior)
+        setEofPos (Just (pos, prior))
+
     let anf = an0 { anns = (anns an0) { am_decls = am_decls' }}
     debugM $ "HsModule, anf=" ++ showAst anf
 
@@ -4761,7 +4766,7 @@ printStringAtLsDelta cl s = do
         -- `debug` ("printStringAtLsDelta:(pos,s):" ++ show (undelta p cl colOffset,s))
       p' <- getPosP
       d <- getPriorEndD
-      debugM $ "printStringAtLsDelta:(pos,p',d,s):" ++ show (undelta p cl colOffset,p',d,s)
+      debugM $ "printStringAtLsDelta:(pos,p,p',d,s):" ++ show (undelta p cl colOffset,p,p',d,s)
     else return () `debug` ("printStringAtLsDelta:bad delta for (mc,s):" ++ show (cl,s))
 
 -- ---------------------------------------------------------------------
@@ -4873,6 +4878,14 @@ setAnchorU rss = do
   debugM $ "setAnchorU:" ++ show (rs2range rss)
   modify (\s -> s { uAnchorSpan = rss })
 
+getEofPos :: (Monad m, Monoid w) => EP w m (Maybe (RealSrcSpan, RealSrcSpan))
+getEofPos = gets epEof
+
+setEofPos :: (Monad m, Monoid w) => Maybe (RealSrcSpan, RealSrcSpan) -> EP w m ()
+setEofPos l = modify (\s -> s {epEof = l})
+
+-- ---------------------------------------------------------------------
+
 getUnallocatedComments :: (Monad m, Monoid w) => EP w m [Comment]
 getUnallocatedComments = gets epComments
 

utils/check-exact/Main.hs

@@ -36,7 +36,8 @@ import GHC.Data.FastString
 -- ---------------------------------------------------------------------
 
 _tt :: IO ()
-_tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/lib/"
+_tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/master/_build/stage1/lib/"
+-- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/lib/"
 -- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprint/_build/stage1/lib"
 -- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/epw/_build/stage1/lib"
 
@@ -58,7 +59,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/
  -- "../../testsuite/tests/ghc-api/exactprint/AddDecl2.hs" (Just changeAddDecl2)
  -- "../../testsuite/tests/ghc-api/exactprint/AddDecl3.hs" (Just changeAddDecl3)
  -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls.hs" (Just changeLocalDecls)
- -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls2.hs" (Just changeLocalDecls2)
+ "../../testsuite/tests/ghc-api/exactprint/LocalDecls2.hs" (Just changeLocalDecls2)
  -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3a.hs" (Just changeWhereIn3a)
  -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3b.hs" (Just changeWhereIn3b)
  -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl1.hs" (Just addLocaLDecl1)
@@ -194,7 +195,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/
  -- "../../testsuite/tests/printer/Test19834.hs" Nothing
  -- "../../testsuite/tests/printer/Test19840.hs" Nothing
  -- "../../testsuite/tests/printer/Test19850.hs" Nothing
- "../../testsuite/tests/printer/Test20258.hs" Nothing
+ -- "../../testsuite/tests/printer/Test20258.hs" Nothing
  -- "../../testsuite/tests/printer/PprLinearArrow.hs" Nothing
  -- "../../testsuite/tests/printer/PprSemis.hs" Nothing
  -- "../../testsuite/tests/printer/PprEmptyMostly.hs" Nothing

utils/check-exact/Orphans.hs

@@ -89,4 +89,4 @@ instance Default EpAnnSumPat where
   def = EpAnnSumPat def  def  def
 
 instance Default AnnsModule where
-  def = AnnsModule [] mempty
+  def = AnnsModule [] mempty Nothing

utils/check-exact/Transform.hs

@@ -709,15 +709,6 @@ commentOrigDelta (L (GHC.Anchor la _) (GHC.EpaComment t pp))
 
 -- ---------------------------------------------------------------------
 
-
--- | For comment-related deltas starting on a new line we have an
--- off-by-one problem. Adjust
-tweakDelta :: DeltaPos  -> DeltaPos
-tweakDelta (SameLine d) = SameLine d
-tweakDelta (DifferentLine l d) = DifferentLine l (d-1)
-
--- ---------------------------------------------------------------------
-
 balanceSameLineComments :: (Monad m)
   => LMatch GhcPs (LHsExpr GhcPs) -> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
 balanceSameLineComments (L la (Match anm mctxt pats (GRHSs x grhss lb))) = do

utils/check-exact/Utils.hs

@@ -172,6 +172,25 @@ isPointSrcSpan ss = spanLength ss == 0
 
 -- ---------------------------------------------------------------------
 
+origDelta :: RealSrcSpan -> RealSrcSpan -> DeltaPos
+origDelta pos pp = op
+  where
+    (r,c) = ss2posEnd pp
+
+    op = if r == 0
+           then (             ss2delta (r,c+1) pos)
+           else (tweakDelta $ ss2delta (r,c  ) pos)
+
+-- ---------------------------------------------------------------------
+
+-- | For comment-related deltas starting on a new line we have an
+-- off-by-one problem. Adjust
+tweakDelta :: DeltaPos  -> DeltaPos
+tweakDelta (SameLine d) = SameLine d
+tweakDelta (DifferentLine l d) = DifferentLine l (d-1)
+
+-- ---------------------------------------------------------------------
+
 -- |Given a list of items and a list of keys, returns a list of items
 -- ordered by their position in the list of keys.
 orderByKey :: [(RealSrcSpan,a)] -> [RealSrcSpan] -> [(RealSrcSpan,a)]

haddock @ 261a7c8a

-Subproject commit 37e3c3683ac70735ab211f59210c9abea8ae2c69
+Subproject commit 261a7c8ac5b5ff29e6e0380690cbb6ee9730f985