[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Fix panic in multiline string with unterminated gap (#25530)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Dec 9 17:05:53 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
72ab8861 by Brandon Chinn at 2024-12-09T12:04:45-05:00
Fix panic in multiline string with unterminated gap (#25530)
- - - - -
54c59b73 by Brandon Chinn at 2024-12-09T12:04:45-05:00
Add test case for unterminated multiline string
- - - - -
9c7b9889 by Rodrigo Mesquita at 2024-12-09T12:04:46-05:00
Revert mapMG renaming
We had previously renamed this function for consistency, but that caused unnecessary breakage
- - - - -
bcee6f20 by Sylvain Henry at 2024-12-09T12:05:00-05:00
RTS: make Cabal flags manual
Cabal shouldn't automatically try to set them. We set them explicitly.
- - - - -
9 changed files:
- compiler/GHC.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Unit/Module/Graph.hs
- rts/rts.cabal
- + testsuite/tests/parser/should_fail/MultilineStringsUnterminated.hs
- + testsuite/tests/parser/should_fail/MultilineStringsUnterminated.stderr
- + testsuite/tests/parser/should_fail/T25530.hs
- + testsuite/tests/parser/should_fail/T25530.stderr
- testsuite/tests/parser/should_fail/all.T
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -74,7 +74,7 @@ module GHC (
compileToCoreModule, compileToCoreSimplified,
-- * Inspecting the module structure of the program
- ModuleGraph, emptyMG, mgMap, mkModuleGraph, mgModSummaries,
+ ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries,
mgLookupModule,
ModSummary(..), ms_mod_name, ModLocation(..),
pattern ModLocation,
@@ -874,7 +874,7 @@ setProgramDynFlags_ invalidate_needed dflags = do
--
invalidateModSummaryCache :: GhcMonad m => m ()
invalidateModSummaryCache =
- modifySession $ \h -> h { hsc_mod_graph = mgMap inval (hsc_mod_graph h) }
+ modifySession $ \h -> h { hsc_mod_graph = mapMG inval (hsc_mod_graph h) }
where
inval ms = ms { ms_hs_hash = fingerprint0 }
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -2204,14 +2204,15 @@ tok_string_multi startSpan startBuf _len _buf2 = do
case alexScan i0 string_multi_content of
AlexToken i1 len _
| Just i2 <- lexDelim i1 -> pure (i1, i2)
- | -- is the next token a tab character?
- -- need this explicitly because there's a global rule matching $tab
- Just ('\t', _) <- alexGetChar' i1 -> setInput i1 >> lexError LexError
- | isEOF i1 -> checkSmartQuotes >> lexError LexError
- | len == 0 -> panic $ "parsing multiline string got into infinite loop at: " ++ show i0
+ | isEOF i1 -> checkSmartQuotes >> setInput i1 >> lexError LexError
+ -- is the next token a tab character?
+ -- need this explicitly because there's a global rule matching $tab
+ | Just ('\t', _) <- alexGetChar' i1 -> setInput i1 >> lexError LexError
+ -- Can happen if no patterns match, e.g. an unterminated gap
+ | len == 0 -> setInput i1 >> lexError LexError
| otherwise -> goContent i1
AlexSkip i1 _ -> goContent i1
- _ -> lexError LexError
+ _ -> setInput i0 >> lexError LexError
lexDelim =
let go 0 i = Just i
=====================================
compiler/GHC/Unit/Module/Graph.hs
=====================================
@@ -46,7 +46,7 @@ module GHC.Unit.Module.Graph
-- (without changing the 'ModuleGraph' structure itself!).
-- 'mgModSummaries' lists out all 'ModSummary's, and
-- 'mgLookupModule' looks up a 'ModSummary' for a given module.
- , mgMap, mgMapM
+ , mapMG, mgMapM
, mgModSummaries
, mgLookupModule
@@ -239,8 +239,8 @@ lengthMG = length . mg_mss
-- | Map a function 'f' over all the 'ModSummaries'.
-- To preserve invariants, 'f' can't change the isBoot status.
-mgMap :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
-mgMap f mg at ModuleGraph{..} = mg
+mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
+mapMG f mg at ModuleGraph{..} = mg
{ mg_mss = flip fmap mg_mss $ \case
InstantiationNode uid iuid -> InstantiationNode uid iuid
LinkNode uid nks -> LinkNode uid nks
=====================================
rts/rts.cabal
=====================================
@@ -30,38 +30,55 @@ source-repository head
flag libm
default: False
+ manual: True
flag librt
default: False
+ manual: True
flag libdl
default: False
+ manual: True
flag use-system-libffi
default: False
+ manual: True
flag libffi-adjustors
default: False
+ manual: True
flag need-pthread
default: False
+ manual: True
flag libbfd
default: False
+ manual: True
flag need-atomic
default: False
+ manual: True
flag libdw
default: False
+ manual: True
flag libnuma
default: False
+ manual: True
flag libzstd
default: False
+ manual: True
flag static-libzstd
default: False
+ manual: True
flag leading-underscore
default: False
+ manual: True
flag unregisterised
default: False
+ manual: True
flag tables-next-to-code
default: False
+ manual: True
flag smp
default: True
+ manual: True
flag find-ptr
default: False
+ manual: True
-- Some cabal flags used to control the flavours we want to produce
-- for libHSrts in hadrian. By default, we just produce vanilla and
-- threaded. The flags "compose": if you enable debug and profiling,
@@ -69,18 +86,23 @@ flag find-ptr
-- _thr_debug_p and so on.
flag profiling
default: False
+ manual: True
flag debug
default: False
+ manual: True
flag dynamic
default: False
+ manual: True
flag threaded
default: False
+ manual: True
flag thread-sanitizer
description:
Enable checking for data races using the ThreadSanitizer (TSAN)
mechanism supported by GCC and Clang. See Note [ThreadSanitizer]
in @rts/include/rts/TSANUtils.h at .
default: False
+ manual: True
library
-- rts is a wired in package and
=====================================
testsuite/tests/parser/should_fail/MultilineStringsUnterminated.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE MultilineStrings #-}
+
+x :: String
+x =
+ """
+ test
+
+y :: Int
+y = 0
=====================================
testsuite/tests/parser/should_fail/MultilineStringsUnterminated.stderr
=====================================
@@ -0,0 +1,3 @@
+MultilineStringsUnterminated.hs:10:1: error: [GHC-21231]
+ lexical error at end of input
+
=====================================
testsuite/tests/parser/should_fail/T25530.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE MultilineStrings #-}
+
+foo =
+ """
+ a\
+ b
+ """
+
+main = print foo
=====================================
testsuite/tests/parser/should_fail/T25530.stderr
=====================================
@@ -0,0 +1,2 @@
+T25530.hs:5:4: error: [GHC-21231] lexical error at character '\\'
+
=====================================
testsuite/tests/parser/should_fail/all.T
=====================================
@@ -231,9 +231,13 @@ test('T17879a', normal, compile_fail, [''])
test('T17879b', normal, compile_fail, [''])
test('Or1', normal, compile_fail, [''])
test('OrPatInExprErr', normal, compile_fail, [''])
+
+# Multiline Strings
test('MultilineStringsError', [normalise_whitespace_fun(lambda s: s)], compile_fail, [''])
test('MultilineStringsSmartQuotes', normal, compile_fail, [''])
test('MultilineStringsInnerTab', normal, compile_fail, [''])
+test('MultilineStringsUnterminated', normal, compile_fail, [''])
test('T25258a', normal, compile_fail, [''])
test('T25258b', normal, compile_fail, [''])
test('T25258c', normal, compile_fail, [''])
+test('T25530', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/de0304c9e844ee29fd4d2d9dea99b94950fdc4e6...bcee6f20f4c86fad233d2aea35b8453adb8093e3
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/de0304c9e844ee29fd4d2d9dea99b94950fdc4e6...bcee6f20f4c86fad233d2aea35b8453adb8093e3
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/20241209/73f8ac5b/attachment-0001.html>
More information about the ghc-commits
mailing list