[Git][ghc/ghc][wip/T22908] 6 commits: testsuite: remove config.use_threads
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Thu Feb 9 10:02:59 UTC 2023
Simon Peyton Jones pushed to branch wip/T22908 at Glasgow Haskell Compiler / GHC
Commits:
633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00
testsuite: remove config.use_threads
This patch simplifies the testsuite driver by removing the use_threads
config field. It's just a degenerate case of threads=1.
- - - - -
ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00
testsuite: use concurrent.futures.ThreadPoolExecutor in the driver
The testsuite driver used to create one thread per test case, and
explicitly use semaphore and locks for rate limiting and
synchronization. This is a bad practice in any language, and
occasionally may result in livelock conditions (e.g. #22889). This
patch uses concurrent.futures.ThreadPoolExecutor for scheduling test
case runs, which is simpler and more robust.
- - - - -
f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00
EPA: Comment between module and where should be in header comments
Do not apply the heuristic to associate a comment with a prior
declaration for the first declaration in the file.
Closes #22919
- - - - -
d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00
JS generated refs: update testsuite conditions
- - - - -
2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00
Bump transformers to 0.6.1.0
This allows us to avoid orphans for Foldable1 instances,
fixing #22898.
Updates transformers submodule.
- - - - -
905f8c3c by Simon Peyton Jones at 2023-02-09T10:03:49+00:00
Improve GHC.Tc.Gen.App.tcInstFun
It wasn't behaving right when inst_final=False, and the
function had no type variables
f :: Foo => Int
Rather a corner case, but we might as well do it right.
Fixes #22908
Unexpectedly, three test cases (all using :type in GHCi) got
slightly better output as a result:
T17403, T14796, T12447
- - - - -
25 changed files:
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Tc/Gen/App.hs
- libraries/transformers
- testsuite/driver/runtests.py
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/driver/testutil.py
- testsuite/tests/driver/T1959/test.T
- testsuite/tests/ffi/should_run/all.T
- + testsuite/tests/ghc-api/exactprint/T22919.hs
- + testsuite/tests/ghc-api/exactprint/T22919.stderr
- testsuite/tests/ghc-api/exactprint/Test20239.stderr
- testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
- testsuite/tests/ghc-api/exactprint/all.T
- testsuite/tests/ghci/scripts/T12447.stdout
- testsuite/tests/ghci/scripts/T14796.stdout
- testsuite/tests/ghci/scripts/T17403.stdout
- + testsuite/tests/ghci/scripts/T22908.script
- + testsuite/tests/ghci/scripts/T22908.stdout
- testsuite/tests/ghci/scripts/all.T
- testsuite/tests/parser/should_compile/DumpParsedAstComments.hs
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
- testsuite/tests/rts/all.T
- testsuite/tests/safeHaskell/check/pkg01/all.T
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -3700,11 +3700,13 @@ allocatePriorComments ss comment_q mheader_comments =
cmp (L l _) = anchor l <= ss
(newAnns,after) = partition cmp comment_q
comment_q'= after
- (prior_comments, decl_comments) = splitPriorComments ss newAnns
+ (prior_comments, decl_comments)
+ = case mheader_comments of
+ Strict.Nothing -> (reverse newAnns, [])
+ _ -> splitPriorComments ss newAnns
in
case mheader_comments of
Strict.Nothing -> (Strict.Just prior_comments, comment_q', decl_comments)
- -- Strict.Nothing -> (Strict.Just [], comment_q', newAnns)
Strict.Just _ -> (mheader_comments, comment_q', reverse newAnns)
allocateFinalComments
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -543,25 +543,16 @@ tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args
HsUnboundVar {} -> True
_ -> False
- inst_all, inst_inferred, inst_none :: ForAllTyFlag -> Bool
- inst_all (Invisible {}) = True
- inst_all Required = False
-
- inst_inferred (Invisible InferredSpec) = True
- inst_inferred (Invisible SpecifiedSpec) = False
- inst_inferred Required = False
-
- inst_none _ = False
-
inst_fun :: [HsExprArg 'TcpRn] -> ForAllTyFlag -> Bool
- inst_fun [] | inst_final = inst_all
- | otherwise = inst_none
- -- Using `inst_none` for `:type` avoids
+ -- True <=> instantiate a tyvar with this ForAllTyFlag
+ inst_fun [] | inst_final = isInvisibleForAllTyFlag
+ | otherwise = const False
+ -- Using `const False` for `:type` avoids
-- `forall {r1} (a :: TYPE r1) {r2} (b :: TYPE r2). a -> b`
-- turning into `forall a {r2} (b :: TYPE r2). a -> b`.
-- See #21088.
- inst_fun (EValArg {} : _) = inst_all
- inst_fun _ = inst_inferred
+ inst_fun (EValArg {} : _) = isInvisibleForAllTyFlag
+ inst_fun _ = isInferredForAllTyFlag
-----------
go, go1 :: Delta
@@ -588,7 +579,12 @@ tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args
-- c.f. GHC.Tc.Utils.Instantiate.topInstantiate
go1 delta acc so_far fun_ty args
| (tvs, body1) <- tcSplitSomeForAllTyVars (inst_fun args) fun_ty
- , (theta, body2) <- tcSplitPhiTy body1
+ , (theta, body2) <- if (inst_fun args Inferred)
+ then tcSplitPhiTy body1
+ else ([], body1)
+ -- (inst_fun args Inferred): dictionary parameters are like Inferred foralls
+ -- E.g. #22908: f :: Foo => blah
+ -- No foralls! But if inst_final=False, don't instantiate
, not (null tvs && null theta)
= do { (inst_tvs, wrap, fun_rho) <- addHeadCtxt fun_ctxt $
instantiateSigma fun_orig tvs theta body2
=====================================
libraries/transformers
=====================================
@@ -1 +1 @@
-Subproject commit ceff1dcd7893f7ab4abb6e66bcd248abd86c8886
+Subproject commit ef4fa181ebea77ac6997d392d1ef5a09524f06b2
=====================================
testsuite/driver/runtests.py
=====================================
@@ -26,7 +26,9 @@ from pathlib import Path
# So we import it here first, so that the testsuite doesn't appear to fail.
import subprocess
-from testutil import getStdout, Watcher, str_warn, str_info, print_table, shorten_metric_name
+from concurrent.futures import ThreadPoolExecutor
+
+from testutil import getStdout, str_warn, str_info, print_table, shorten_metric_name
from testglobals import getConfig, ghc_env, getTestRun, TestConfig, \
TestOptions, brokens, PerfMetric
from my_typing import TestName
@@ -151,7 +153,6 @@ config.broken_tests |= {TestName(t) for t in args.broken_test}
if args.threads:
config.threads = args.threads
- config.use_threads = True
if args.verbose is not None:
config.verbose = args.verbose
@@ -481,26 +482,28 @@ if config.list_broken:
print('WARNING:', len(t.framework_failures), 'framework failures!')
print('')
else:
- # completion watcher
- watcher = Watcher(len(parallelTests))
-
# Now run all the tests
try:
- for oneTest in parallelTests:
- if stopping():
- break
- oneTest(watcher)
+ with ThreadPoolExecutor(max_workers=config.threads) as executor:
+ for oneTest in parallelTests:
+ if stopping():
+ break
+ oneTest(executor)
- # wait for parallel tests to finish
- if not stopping():
- watcher.wait()
+ # wait for parallel tests to finish
+ if not stopping():
+ executor.shutdown(wait=True)
# Run the following tests purely sequential
- config.use_threads = False
- for oneTest in aloneTests:
- if stopping():
- break
- oneTest(watcher)
+ with ThreadPoolExecutor(max_workers=1) as executor:
+ for oneTest in aloneTests:
+ if stopping():
+ break
+ oneTest(executor)
+
+ if not stopping():
+ executor.shutdown(wait=True)
+
except KeyboardInterrupt:
pass
=====================================
testsuite/driver/testglobals.py
=====================================
@@ -177,7 +177,6 @@ class TestConfig:
# threads
self.threads = 1
- self.use_threads = False
# tests which should be considered to be broken during this testsuite
# run.
=====================================
testsuite/driver/testlib.py
=====================================
@@ -36,10 +36,7 @@ from my_typing import *
from threading import Timer
from collections import OrderedDict
-global pool_sema
-if config.use_threads:
- import threading
- pool_sema = threading.BoundedSemaphore(value=config.threads)
+import threading
global wantToStop
wantToStop = False
@@ -84,12 +81,7 @@ def get_all_ways() -> Set[WayName]:
# testdir_testopts after each test).
global testopts_local
-if config.use_threads:
- testopts_local = threading.local()
-else:
- class TestOpts_Local:
- pass
- testopts_local = TestOpts_Local() # type: ignore
+testopts_local = threading.local()
def getTestOpts() -> TestOptions:
return testopts_local.x
@@ -1020,16 +1012,8 @@ parallelTests = []
aloneTests = []
allTestNames = set([]) # type: Set[TestName]
-def runTest(watcher, opts, name: TestName, func, args):
- if config.use_threads:
- pool_sema.acquire()
- t = threading.Thread(target=test_common_thread,
- name=name,
- args=(watcher, name, opts, func, args))
- t.daemon = False
- t.start()
- else:
- test_common_work(watcher, name, opts, func, args)
+def runTest(executor, opts, name: TestName, func, args):
+ return executor.submit(test_common_work, name, opts, func, args)
# name :: String
# setup :: [TestOpt] -> IO ()
@@ -1067,20 +1051,13 @@ def test(name: TestName,
if name in config.broken_tests:
myTestOpts.expect = 'fail'
- thisTest = lambda watcher: runTest(watcher, myTestOpts, name, func, args)
+ thisTest = lambda executor: runTest(executor, myTestOpts, name, func, args)
if myTestOpts.alone:
aloneTests.append(thisTest)
else:
parallelTests.append(thisTest)
allTestNames.add(name)
-if config.use_threads:
- def test_common_thread(watcher, name, opts, func, args):
- try:
- test_common_work(watcher, name, opts, func, args)
- finally:
- pool_sema.release()
-
def get_package_cache_timestamp() -> float:
if config.package_conf_cache_file is None:
return 0.0
@@ -1094,8 +1071,7 @@ do_not_copy = ('.hi', '.o', '.dyn_hi'
, '.dyn_o', '.out'
,'.hi-boot', '.o-boot') # 12112
-def test_common_work(watcher: testutil.Watcher,
- name: TestName, opts,
+def test_common_work(name: TestName, opts,
func, args) -> None:
try:
t.total_tests += 1
@@ -1214,8 +1190,6 @@ def test_common_work(watcher: testutil.Watcher,
except Exception as e:
framework_fail(name, None, 'Unhandled exception: ' + str(e))
- finally:
- watcher.notify()
def do_test(name: TestName,
way: WayName,
=====================================
testsuite/driver/testutil.py
=====================================
@@ -5,8 +5,6 @@ import tempfile
from pathlib import Path, PurePath
from term_color import Color, colored
-import threading
-
from my_typing import *
@@ -125,24 +123,6 @@ else:
else:
os.symlink(str(src), str(dst))
-class Watcher(object):
- def __init__(self, count: int) -> None:
- self.pool = count
- self.evt = threading.Event()
- self.sync_lock = threading.Lock()
- if count <= 0:
- self.evt.set()
-
- def wait(self):
- self.evt.wait()
-
- def notify(self):
- self.sync_lock.acquire()
- self.pool -= 1
- if self.pool <= 0:
- self.evt.set()
- self.sync_lock.release()
-
def memoize(f):
"""
A decorator to memoize a nullary function.
=====================================
testsuite/tests/driver/T1959/test.T
=====================================
@@ -1 +1 @@
-test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22261)], makefile_test, ['dotest'])
+test('T1959', [extra_files(['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs']), js_broken(22374)], makefile_test, ['dotest'])
=====================================
testsuite/tests/ffi/should_run/all.T
=====================================
@@ -167,10 +167,10 @@ test('T5594', [ omit_ways(['ghci']),
],
compile_and_run, ['T5594_c.c -no-hs-main'])
-test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), js_broken(22374)],
+test('Capi_Ctype_001', [extra_files(['Capi_Ctype_A_001.hsc', 'capi_ctype_001.h', 'capi_ctype_001_c.c']), req_c],
makefile_test, ['Capi_Ctype_001'])
-test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), js_broken(22374)],
+test('Capi_Ctype_002', [extra_files(['Capi_Ctype_A_002.hsc', 'capi_ctype_002_A.h', 'capi_ctype_002_B.h']), req_c],
makefile_test, ['Capi_Ctype_002'])
test('ffi_parsing_001', [omit_ways(['ghci']), req_c], compile_and_run,
=====================================
testsuite/tests/ghc-api/exactprint/T22919.hs
=====================================
@@ -0,0 +1,2 @@
+module T22919 {- comment -} where
+foo = 's'
=====================================
testsuite/tests/ghc-api/exactprint/T22919.stderr
=====================================
@@ -0,0 +1,116 @@
+
+==================== Parser AST ====================
+
+(L
+ { T22919.hs:1:1 }
+ (HsModule
+ (XModulePs
+ (EpAnn
+ (Anchor
+ { T22919.hs:1:1 }
+ (UnchangedAnchor))
+ (AnnsModule
+ [(AddEpAnn AnnModule (EpaSpan { T22919.hs:1:1-6 }))
+ ,(AddEpAnn AnnWhere (EpaSpan { T22919.hs:1:29-33 }))]
+ (AnnList
+ (Nothing)
+ (Nothing)
+ (Nothing)
+ []
+ [])
+ (Just
+ ((,)
+ { T22919.hs:3:1 }
+ { T22919.hs:2:7-9 })))
+ (EpaCommentsBalanced
+ [(L
+ (Anchor
+ { T22919.hs:1:15-27 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaBlockComment
+ "{- comment -}")
+ { T22919.hs:1:8-13 }))]
+ []))
+ (VirtualBraces
+ (1))
+ (Nothing)
+ (Nothing))
+ (Just
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:1:8-13 })
+ {ModuleName: T22919}))
+ (Nothing)
+ []
+ [(L
+ (SrcSpanAnn (EpAnn
+ (Anchor
+ { T22919.hs:2:1-9 }
+ (UnchangedAnchor))
+ (AnnListItem
+ [])
+ (EpaComments
+ [])) { T22919.hs:2:1-9 })
+ (ValD
+ (NoExtField)
+ (FunBind
+ (NoExtField)
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 })
+ (Unqual
+ {OccName: foo}))
+ (MG
+ (FromSource)
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 })
+ [(L
+ (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 })
+ (Match
+ (EpAnn
+ (Anchor
+ { T22919.hs:2:1-9 }
+ (UnchangedAnchor))
+ []
+ (EpaComments
+ []))
+ (FunRhs
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 })
+ (Unqual
+ {OccName: foo}))
+ (Prefix)
+ (NoSrcStrict))
+ []
+ (GRHSs
+ (EpaComments
+ [])
+ [(L
+ (SrcSpanAnn
+ (EpAnnNotUsed)
+ { T22919.hs:2:5-9 })
+ (GRHS
+ (EpAnn
+ (Anchor
+ { T22919.hs:2:5-9 }
+ (UnchangedAnchor))
+ (GrhsAnn
+ (Nothing)
+ (AddEpAnn AnnEqual (EpaSpan { T22919.hs:2:5 })))
+ (EpaComments
+ []))
+ []
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:7-9 })
+ (HsLit
+ (EpAnn
+ (Anchor
+ { T22919.hs:2:7-9 }
+ (UnchangedAnchor))
+ (NoEpAnns)
+ (EpaComments
+ []))
+ (HsChar
+ (SourceText 's')
+ ('s'))))))]
+ (EmptyLocalBinds
+ (NoExtField)))))])))))]))
=====================================
testsuite/tests/ghc-api/exactprint/Test20239.stderr
=====================================
@@ -23,7 +23,14 @@
{ Test20239.hs:8:1 }
{ Test20239.hs:7:34-63 })))
(EpaCommentsBalanced
- []
+ [(L
+ (Anchor
+ { Test20239.hs:3:1-28 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaLineComment
+ "-- | Leading Haddock Comment")
+ { Test20239.hs:1:18-22 }))]
[(L
(Anchor
{ Test20239.hs:7:34-63 }
@@ -50,14 +57,7 @@
(AnnListItem
[])
(EpaComments
- [(L
- (Anchor
- { Test20239.hs:3:1-28 }
- (UnchangedAnchor))
- (EpaComment
- (EpaLineComment
- "-- | Leading Haddock Comment")
- { Test20239.hs:1:18-22 }))])) { Test20239.hs:(4,1)-(6,86) })
+ [])) { Test20239.hs:(4,1)-(6,86) })
(InstD
(NoExtField)
(DataFamInstD
@@ -323,5 +323,5 @@
-Test20239.hs:4:15: error: [GHC-76037]
+Test20239.hs:4:15: [GHC-76037]
Not in scope: type constructor or class ‘Method’
=====================================
testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
=====================================
@@ -30,7 +30,15 @@
(EpaComment
(EpaLineComment
"-- leading comments")
- { ZeroWidthSemi.hs:1:22-26 }))]
+ { ZeroWidthSemi.hs:1:22-26 }))
+ ,(L
+ (Anchor
+ { ZeroWidthSemi.hs:5:1-19 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaLineComment
+ "-- Function comment")
+ { ZeroWidthSemi.hs:3:1-19 }))]
[(L
(Anchor
{ ZeroWidthSemi.hs:8:1-58 }
@@ -57,14 +65,7 @@
(AnnListItem
[])
(EpaComments
- [(L
- (Anchor
- { ZeroWidthSemi.hs:5:1-19 }
- (UnchangedAnchor))
- (EpaComment
- (EpaLineComment
- "-- Function comment")
- { ZeroWidthSemi.hs:3:1-19 }))])) { ZeroWidthSemi.hs:6:1-5 })
+ [])) { ZeroWidthSemi.hs:6:1-5 })
(ValD
(NoExtField)
(FunBind
=====================================
testsuite/tests/ghc-api/exactprint/all.T
=====================================
@@ -38,3 +38,4 @@ test('AddHiding1', ignore_stderr, makefile_test, ['AddHiding1'])
test('AddHiding2', ignore_stderr, makefile_test, ['AddHiding2'])
test('Test20239', normal, compile_fail, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments'])
test('ZeroWidthSemi', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments'])
+test('T22919', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments'])
=====================================
testsuite/tests/ghci/scripts/T12447.stdout
=====================================
@@ -1,3 +1,3 @@
deferEither @(_ ~ _)
- :: (Typeable w1, Typeable w2) =>
+ :: Deferrable (w1 ~ w2) =>
proxy (w1 ~ w2) -> ((w1 ~ w2) => r) -> Either String r
=====================================
testsuite/tests/ghci/scripts/T14796.stdout
=====================================
@@ -1 +1,2 @@
-ECC @() @[] @() :: [()] -> ECC (() :: Constraint) [] ()
+ECC @() @[] @()
+ :: (() :: Constraint) => [()] -> ECC (() :: Constraint) [] ()
=====================================
testsuite/tests/ghci/scripts/T17403.stdout
=====================================
@@ -1 +1 @@
-f :: String
+f :: (() :: Constraint) => String
=====================================
testsuite/tests/ghci/scripts/T22908.script
=====================================
@@ -0,0 +1,4 @@
+:set -XMultiParamTypeClasses
+class Foo where foo :: Int
+:t foo
+
=====================================
testsuite/tests/ghci/scripts/T22908.stdout
=====================================
@@ -0,0 +1 @@
+foo :: Foo => Int
=====================================
testsuite/tests/ghci/scripts/all.T
=====================================
@@ -372,3 +372,4 @@ test('T21294a', normal, ghci_script, ['T21294a.script'])
test('T21507', normal, ghci_script, ['T21507.script'])
test('T22695', normal, ghci_script, ['T22695.script'])
test('T22817', normal, ghci_script, ['T22817.script'])
+test('T22908', normal, ghci_script, ['T22908.script'])
=====================================
testsuite/tests/parser/should_compile/DumpParsedAstComments.hs
=====================================
@@ -4,6 +4,9 @@
-}
module DumpParsedAstComments where
+-- comment 1 for bar
+-- comment 2 for bar
+bar = 1
-- Other comment
-- comment 1 for foo
=====================================
testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
=====================================
@@ -21,8 +21,8 @@
[])
(Just
((,)
- { DumpParsedAstComments.hs:17:1 }
- { DumpParsedAstComments.hs:16:17-23 })))
+ { DumpParsedAstComments.hs:20:1 }
+ { DumpParsedAstComments.hs:19:17-23 })))
(EpaCommentsBalanced
[(L
(Anchor
@@ -42,12 +42,20 @@
{ DumpParsedAstComments.hs:1:1-28 }))
,(L
(Anchor
- { DumpParsedAstComments.hs:7:1-16 }
+ { DumpParsedAstComments.hs:7:1-20 }
(UnchangedAnchor))
(EpaComment
(EpaLineComment
- "-- Other comment")
- { DumpParsedAstComments.hs:5:30-34 }))]
+ "-- comment 1 for bar")
+ { DumpParsedAstComments.hs:5:30-34 }))
+ ,(L
+ (Anchor
+ { DumpParsedAstComments.hs:8:1-20 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaLineComment
+ "-- comment 2 for bar")
+ { DumpParsedAstComments.hs:7:1-20 }))]
[]))
(VirtualBraces
(1))
@@ -62,55 +70,139 @@
[(L
(SrcSpanAnn (EpAnn
(Anchor
- { DumpParsedAstComments.hs:(11,1)-(13,3) }
+ { DumpParsedAstComments.hs:9:1-7 }
+ (UnchangedAnchor))
+ (AnnListItem
+ [])
+ (EpaComments
+ [])) { DumpParsedAstComments.hs:9:1-7 })
+ (ValD
+ (NoExtField)
+ (FunBind
+ (NoExtField)
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 })
+ (Unqual
+ {OccName: bar}))
+ (MG
+ (FromSource)
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 })
+ [(L
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 })
+ (Match
+ (EpAnn
+ (Anchor
+ { DumpParsedAstComments.hs:9:1-7 }
+ (UnchangedAnchor))
+ []
+ (EpaComments
+ []))
+ (FunRhs
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 })
+ (Unqual
+ {OccName: bar}))
+ (Prefix)
+ (NoSrcStrict))
+ []
+ (GRHSs
+ (EpaComments
+ [])
+ [(L
+ (SrcSpanAnn
+ (EpAnnNotUsed)
+ { DumpParsedAstComments.hs:9:5-7 })
+ (GRHS
+ (EpAnn
+ (Anchor
+ { DumpParsedAstComments.hs:9:5-7 }
+ (UnchangedAnchor))
+ (GrhsAnn
+ (Nothing)
+ (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:9:5 })))
+ (EpaComments
+ []))
+ []
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:7 })
+ (HsOverLit
+ (EpAnn
+ (Anchor
+ { DumpParsedAstComments.hs:9:7 }
+ (UnchangedAnchor))
+ (NoEpAnns)
+ (EpaComments
+ []))
+ (OverLit
+ (NoExtField)
+ (HsIntegral
+ (IL
+ (SourceText 1)
+ (False)
+ (1))))))))]
+ (EmptyLocalBinds
+ (NoExtField)))))])))))
+ ,(L
+ (SrcSpanAnn (EpAnn
+ (Anchor
+ { DumpParsedAstComments.hs:(14,1)-(16,3) }
(UnchangedAnchor))
(AnnListItem
[])
(EpaComments
[(L
(Anchor
- { DumpParsedAstComments.hs:9:1-20 }
+ { DumpParsedAstComments.hs:10:1-16 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaLineComment
+ "-- Other comment")
+ { DumpParsedAstComments.hs:9:7 }))
+ ,(L
+ (Anchor
+ { DumpParsedAstComments.hs:12:1-20 }
(UnchangedAnchor))
(EpaComment
(EpaLineComment
"-- comment 1 for foo")
- { DumpParsedAstComments.hs:7:1-16 }))
+ { DumpParsedAstComments.hs:10:1-16 }))
,(L
(Anchor
- { DumpParsedAstComments.hs:10:1-20 }
+ { DumpParsedAstComments.hs:13:1-20 }
(UnchangedAnchor))
(EpaComment
(EpaLineComment
"-- comment 2 for foo")
- { DumpParsedAstComments.hs:9:1-20
- }))])) { DumpParsedAstComments.hs:(11,1)-(13,3) })
+ { DumpParsedAstComments.hs:12:1-20
+ }))])) { DumpParsedAstComments.hs:(14,1)-(16,3) })
(ValD
(NoExtField)
(FunBind
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 })
(Unqual
{OccName: foo}))
(MG
(FromSource)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3)
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3)
})
[(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3)
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3)
})
(Match
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:(11,1)-(13,3) }
+ { DumpParsedAstComments.hs:(14,1)-(16,3) }
(UnchangedAnchor))
[]
(EpaComments
[]))
(FunRhs
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 })
(Unqual
{OccName: foo}))
(Prefix)
@@ -122,72 +214,72 @@
[(L
(SrcSpanAnn
(EpAnnNotUsed)
- { DumpParsedAstComments.hs:(11,5)-(13,3) })
+ { DumpParsedAstComments.hs:(14,5)-(16,3) })
(GRHS
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:(11,5)-(13,3) }
+ { DumpParsedAstComments.hs:(14,5)-(16,3) }
(UnchangedAnchor))
(GrhsAnn
(Nothing)
- (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:11:5 })))
+ (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:14:5 })))
(EpaComments
[]))
[]
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,7)-(13,3)
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,7)-(16,3)
})
(HsDo
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:(11,7)-(13,3) }
+ { DumpParsedAstComments.hs:(14,7)-(16,3) }
(UnchangedAnchor))
(AnnList
(Just
(Anchor
- { DumpParsedAstComments.hs:13:3 }
+ { DumpParsedAstComments.hs:16:3 }
(UnchangedAnchor)))
(Nothing)
(Nothing)
- [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:11:7-8 }))]
+ [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:14:7-8 }))]
[])
(EpaComments
[(L
(Anchor
- { DumpParsedAstComments.hs:12:3-19 }
+ { DumpParsedAstComments.hs:15:3-19 }
(UnchangedAnchor))
(EpaComment
(EpaLineComment
"-- normal comment")
- { DumpParsedAstComments.hs:11:7-8 }))]))
+ { DumpParsedAstComments.hs:14:7-8 }))]))
(DoExpr
(Nothing))
(L
(SrcSpanAnn (EpAnn
(Anchor
- { DumpParsedAstComments.hs:13:3 }
+ { DumpParsedAstComments.hs:16:3 }
(UnchangedAnchor))
(AnnList
(Just
(Anchor
- { DumpParsedAstComments.hs:13:3 }
+ { DumpParsedAstComments.hs:16:3 }
(UnchangedAnchor)))
(Nothing)
(Nothing)
[]
[])
(EpaComments
- [])) { DumpParsedAstComments.hs:13:3 })
+ [])) { DumpParsedAstComments.hs:16:3 })
[(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 })
(BodyStmt
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 })
(HsOverLit
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:13:3 }
+ { DumpParsedAstComments.hs:16:3 }
(UnchangedAnchor))
(NoEpAnns)
(EpaComments
@@ -206,45 +298,45 @@
,(L
(SrcSpanAnn (EpAnn
(Anchor
- { DumpParsedAstComments.hs:16:1-23 }
+ { DumpParsedAstComments.hs:19:1-23 }
(UnchangedAnchor))
(AnnListItem
[])
(EpaComments
[(L
(Anchor
- { DumpParsedAstComments.hs:15:1-20 }
+ { DumpParsedAstComments.hs:18:1-20 }
(UnchangedAnchor))
(EpaComment
(EpaLineComment
"-- | Haddock comment")
- { DumpParsedAstComments.hs:13:3
- }))])) { DumpParsedAstComments.hs:16:1-23 })
+ { DumpParsedAstComments.hs:16:3
+ }))])) { DumpParsedAstComments.hs:19:1-23 })
(ValD
(NoExtField)
(FunBind
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 })
(Unqual
{OccName: main}))
(MG
(FromSource)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 })
[(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 })
(Match
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:16:1-23 }
+ { DumpParsedAstComments.hs:19:1-23 }
(UnchangedAnchor))
[]
(EpaComments
[]))
(FunRhs
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 })
(Unqual
{OccName: main}))
(Prefix)
@@ -256,42 +348,42 @@
[(L
(SrcSpanAnn
(EpAnnNotUsed)
- { DumpParsedAstComments.hs:16:6-23 })
+ { DumpParsedAstComments.hs:19:6-23 })
(GRHS
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:16:6-23 }
+ { DumpParsedAstComments.hs:19:6-23 }
(UnchangedAnchor))
(GrhsAnn
(Nothing)
- (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:16:6 })))
+ (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:19:6 })))
(EpaComments
[]))
[]
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-23 })
(HsApp
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:16:8-23 }
+ { DumpParsedAstComments.hs:19:8-23 }
(UnchangedAnchor))
(NoEpAnns)
(EpaComments
[]))
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 })
(HsVar
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 })
(Unqual
{OccName: putStrLn}))))
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:17-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:17-23 })
(HsLit
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:16:17-23 }
+ { DumpParsedAstComments.hs:19:17-23 }
(UnchangedAnchor))
(NoEpAnns)
(EpaComments
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -258,7 +258,7 @@ test('T6006', [ omit_ways(prof_ways + ['ghci']),
# needs it.
compile_and_run, ['T6006_c.c -no-hs-main'])
-test('T7037', js_broken(22374), makefile_test, ['T7037'])
+test('T7037', req_c, makefile_test, ['T7037'])
test('T7087', exit_code(1), compile_and_run, [''])
test('T7160', [ omit_ways(['nonmoving_thr', 'nonmoving_thr_ghc'])
=====================================
testsuite/tests/safeHaskell/check/pkg01/all.T
=====================================
@@ -32,7 +32,7 @@ test('safePkg01',
normalise_version("array", "ghc-bignum", "bytestring",
"base", "deepseq", "ghc-prim"),
normalise_fun(normalise_errmsg),
- js_skip],
+ js_broken(22356)],
run_command, ['$MAKE -s --no-print-directory safePkg01 ' + make_args])
# Fail since we enable package trust
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -152,7 +152,7 @@ test('T7702',
# allocation done by the plugin... but a regression allocates > 90mb
collect_compiler_stats('peak_megabytes_allocated',70),
when(opsys('mingw32'), fragile_for(16799, ['normal'])),
- js_skip
+ req_interp
],
compile,
['-v0 -package-db T7702plugin/pkg.T7702/local.package.conf -fplugin T7702Plugin -package T7702plugin ' + config.plugin_way_flags])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc868bc0bea28b86f164e670c7db702f36acfa02...905f8c3c3e7cfa907e8a88b2ba3854ae01140fbc
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc868bc0bea28b86f164e670c7db702f36acfa02...905f8c3c3e7cfa907e8a88b2ba3854ae01140fbc
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/20230209/b0fe2305/attachment-0001.html>
More information about the ghc-commits
mailing list