[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: ts: add compile_artifact, ignore_extension flag
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Jan 10 07:14:30 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
5d54b716 by doyougnu at 2024-01-10T02:14:00-05:00
ts: add compile_artifact, ignore_extension flag
In b521354216f2821e00d75f088d74081d8b236810 the testsuite gained the
capability to collect generic metrics. But this assumed that the test
was not linking and producing artifacts and we only wanted to track
object files, interface files, or build artifacts from the compiler
build. However, some backends, such as the JS backend, produce artifacts when
compiling, such as the jsexe directory which we want to track.
This patch:
- tweaks the testsuite to collect generic metrics on any build artifact
in the test directory.
- expands the exe_extension function to consider windows and adds the
ignore_extension flag.
- Modifies certain tests to add the ignore_extension flag. Tests such as
heaprof002 expect a .ps file, but on windows without ignore_extensions
the testsuite will look for foo.exe.ps. Hence the flag.
- adds the size_hello_artifact test
- - - - -
0009c5a1 by amesgen at 2024-01-10T02:14:04-05:00
WASM metadata: use correct GHC version
- - - - -
fad0c53f by Xiaoyan Ren at 2024-01-10T02:14:07-05:00
Allow SCC declarations in TH (#24081)
- - - - -
0a7dbc06 by Xiaoyan Ren at 2024-01-10T02:14:07-05:00
Fix prettyprinting of SCC pragmas
- - - - -
4cf15b15 by Simon Peyton Jones at 2024-01-10T02:14:07-05:00
Make TYPE and CONSTRAINT not-apart
Issue #24279 showed up a bug in the logic in GHC.Core.Unify.unify_ty
which is supposed to make TYPE and CONSTRAINT be not-apart.
Easily fixed.
- - - - -
ba5b4954 by Zubin Duggal at 2024-01-10T02:14:08-05:00
ci: Fix typo in mk_ghcup_metadata.py
There was a missing colon in the fix to #24268 in 989bf8e53c08eb22de716901b914b3607bc8dd08
- - - - -
d6740134 by Zubin Duggal at 2024-01-10T02:14:08-05:00
release-ci: remove release-x86_64-linux-deb11-release+boot_nonmoving_gc job
There is no reason to have this release build or distribute this variation.
This configuration is for testing purposes only.
- - - - -
30 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/CmmToAsm/Wasm/Asm.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/SourceText.hs
- libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
- libraries/template-haskell/Language/Haskell/TH/Ppr.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- libraries/template-haskell/changelog.md
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/tests/hpc/function/test.T
- testsuite/tests/hpc/function2/test.T
- testsuite/tests/hpc/simple/test.T
- testsuite/tests/perf/size/all.T
- + testsuite/tests/perf/size/size_hello_artifact.hs
- testsuite/tests/profiling/should_run/all.T
- + testsuite/tests/th/should_compile/T24081/Main.hs
- + testsuite/tests/th/should_compile/T24081/Makefile
- + testsuite/tests/th/should_compile/T24081/T24081.stderr
- + testsuite/tests/th/should_compile/T24081/TH.hs
- + testsuite/tests/th/should_compile/T24081/all.T
- + testsuite/tests/typecheck/should_fail/T24279.hs
- + testsuite/tests/typecheck/should_fail/T24279.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/typecheck/testeq1/test.T
Changes:
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -1020,7 +1020,7 @@ job_groups =
make_wasm_jobs wasm_build_config {bignumBackend = Native}
, modifyValidateJobs manual $
make_wasm_jobs wasm_build_config {unregisterised = True}
- , onlyRule NonmovingGc (standardBuildsWithConfig Amd64 (Linux Debian11) vanilla {validateNonmovingGc = True})
+ , onlyRule NonmovingGc (validateBuilds Amd64 (Linux Debian11) vanilla {validateNonmovingGc = True})
, onlyRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe)
]
=====================================
.gitlab/jobs.yaml
=====================================
@@ -3565,70 +3565,6 @@
"XZ_OPT": "-9"
}
},
- "release-x86_64-linux-deb11-release+boot_nonmoving_gc": {
- "after_script": [
- ".gitlab/ci.sh save_cache",
- ".gitlab/ci.sh save_test_output",
- ".gitlab/ci.sh clean",
- "cat ci_timings"
- ],
- "allow_failure": false,
- "artifacts": {
- "expire_in": "1 year",
- "paths": [
- "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc.tar.xz",
- "junit.xml",
- "unexpected-test-output.tar.gz"
- ],
- "reports": {
- "junit": "junit.xml"
- },
- "when": "always"
- },
- "cache": {
- "key": "x86_64-linux-deb11-$CACHE_REV",
- "paths": [
- "cabal-cache",
- "toolchain"
- ]
- },
- "dependencies": [],
- "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV",
- "needs": [
- {
- "artifacts": false,
- "job": "hadrian-ghc-in-ghci"
- }
- ],
- "rules": [
- {
- "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)",
- "when": "on_success"
- }
- ],
- "script": [
- "sudo chown ghc:ghc -R .",
- ".gitlab/ci.sh setup",
- ".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian",
- ".gitlab/ci.sh test_hadrian"
- ],
- "stage": "full-build",
- "tags": [
- "x86_64-linux"
- ],
- "variables": {
- "BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc",
- "BUILD_FLAVOUR": "release+boot_nonmoving_gc",
- "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--hash-unit-ids",
- "IGNORE_PERF_FAILURES": "all",
- "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity",
- "TEST_ENV": "x86_64-linux-deb11-release+boot_nonmoving_gc",
- "XZ_OPT": "-9"
- }
- },
"release-x86_64-linux-deb12-release": {
"after_script": [
".gitlab/ci.sh save_cache",
=====================================
.gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
=====================================
@@ -145,7 +145,7 @@ def mk_one_metadata(release_mode, version, job_map, artifact):
# So we must manually set the name of the bindist location
if artifact == test_artifact:
bindist_name = "testsuite"
- else
+ else:
bindist_name = fetch_gitlab.job_triple(artifact.job_name)
final_url = release_base.format( version=version
, bindistName=urllib.parse.quote_plus(f"{bindist_name}.tar.xz"))
=====================================
compiler/GHC/Builtin/Names/TH.hs
=====================================
@@ -76,7 +76,8 @@ templateHaskellNames = [
classDName, instanceWithOverlapDName,
standaloneDerivWithStrategyDName, sigDName, kiSigDName, forImpDName,
pragInlDName, pragOpaqueDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName,
- pragRuleDName, pragCompleteDName, pragAnnDName, defaultSigDName, defaultDName,
+ pragRuleDName, pragCompleteDName, pragAnnDName, pragSCCFunDName, pragSCCFunNamedDName,
+ defaultSigDName, defaultDName,
dataFamilyDName, openTypeFamilyDName, closedTypeFamilyDName,
dataInstDName, newtypeInstDName, tySynInstDName,
infixLDName, infixRDName, infixNDName,
@@ -374,7 +375,8 @@ recSName = libFun (fsLit "recS") recSIdKey
funDName, valDName, dataDName, newtypeDName, typeDataDName, tySynDName, classDName,
instanceWithOverlapDName, sigDName, kiSigDName, forImpDName, pragInlDName,
pragSpecDName, pragSpecInlDName, pragSpecInstDName, pragRuleDName,
- pragAnnDName, standaloneDerivWithStrategyDName, defaultSigDName, defaultDName,
+ pragAnnDName, pragSCCFunDName, pragSCCFunNamedDName,
+ standaloneDerivWithStrategyDName, defaultSigDName, defaultDName,
dataInstDName, newtypeInstDName, tySynInstDName, dataFamilyDName,
openTypeFamilyDName, closedTypeFamilyDName, infixLDName, infixRDName,
infixNDName, roleAnnotDName, patSynDName, patSynSigDName,
@@ -401,6 +403,8 @@ pragSpecInstDName = libFun (fsLit "pragSpecInstD")
pragRuleDName = libFun (fsLit "pragRuleD") pragRuleDIdKey
pragCompleteDName = libFun (fsLit "pragCompleteD") pragCompleteDIdKey
pragAnnDName = libFun (fsLit "pragAnnD") pragAnnDIdKey
+pragSCCFunDName = libFun (fsLit "pragSCCFunD") pragSCCFunDKey
+pragSCCFunNamedDName = libFun (fsLit "pragSCCFunNamedD") pragSCCFunNamedDKey
dataInstDName = libFun (fsLit "dataInstD") dataInstDIdKey
newtypeInstDName = libFun (fsLit "newtypeInstD") newtypeInstDIdKey
tySynInstDName = libFun (fsLit "tySynInstD") tySynInstDIdKey
@@ -921,7 +925,8 @@ funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey, classDIdKey,
newtypeInstDIdKey, tySynInstDIdKey, standaloneDerivWithStrategyDIdKey,
infixLDIdKey, infixRDIdKey, infixNDIdKey, roleAnnotDIdKey, patSynDIdKey,
patSynSigDIdKey, pragCompleteDIdKey, implicitParamBindDIdKey,
- kiSigDIdKey, defaultDIdKey, pragOpaqueDIdKey, typeDataDIdKey :: Unique
+ kiSigDIdKey, defaultDIdKey, pragOpaqueDIdKey, typeDataDIdKey,
+ pragSCCFunDKey, pragSCCFunNamedDKey :: Unique
funDIdKey = mkPreludeMiscIdUnique 320
valDIdKey = mkPreludeMiscIdUnique 321
dataDIdKey = mkPreludeMiscIdUnique 322
@@ -958,6 +963,8 @@ kiSigDIdKey = mkPreludeMiscIdUnique 352
defaultDIdKey = mkPreludeMiscIdUnique 353
pragOpaqueDIdKey = mkPreludeMiscIdUnique 354
typeDataDIdKey = mkPreludeMiscIdUnique 355
+pragSCCFunDKey = mkPreludeMiscIdUnique 356
+pragSCCFunNamedDKey = mkPreludeMiscIdUnique 357
-- type Cxt = ...
cxtIdKey :: Unique
=====================================
compiler/GHC/CmmToAsm/Wasm/Asm.hs
=====================================
@@ -12,6 +12,7 @@ import Control.Monad.Trans.Reader
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Builder
+import qualified Data.ByteString.Char8 as BS8
import Data.Coerce
import Data.Foldable
import qualified GHC.Data.Word64Set as WS
@@ -25,6 +26,7 @@ import GHC.CmmToAsm.Wasm.Utils
import GHC.Data.FastString
import GHC.Float
import GHC.Prelude
+import GHC.Settings.Config (cProjectVersion)
import GHC.Types.Basic
import GHC.Types.Unique
import GHC.Types.Unique.Map
@@ -485,7 +487,7 @@ asmTellProducers = do
asmTellVec
[ do
asmTellBS "ghc"
- asmTellBS "9.6"
+ asmTellBS $ BS8.pack cProjectVersion
]
]
=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -31,6 +31,7 @@ import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Types.Var.Set
import GHC.Types.Name( Name, mkSysTvName, mkSystemVarName )
+import GHC.Builtin.Names( tYPETyConKey, cONSTRAINTTyConKey )
import GHC.Core.Type hiding ( getTvSubstEnv )
import GHC.Core.Coercion hiding ( getCvSubstEnv )
import GHC.Core.TyCon
@@ -1149,8 +1150,10 @@ unify_ty env ty1 ty2 _kco
-- TYPE and CONSTRAINT are not Apart
-- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim
-- NB: at this point we know that the two TyCons do not match
- | Just {} <- sORTKind_maybe ty1
- , Just {} <- sORTKind_maybe ty2
+ | Just (tc1,_) <- mb_tc_app1, let u1 = tyConUnique tc1
+ , Just (tc2,_) <- mb_tc_app2, let u2 = tyConUnique tc2
+ , (u1 == tYPETyConKey && u2 == cONSTRAINTTyConKey) ||
+ (u2 == tYPETyConKey && u1 == cONSTRAINTTyConKey)
= maybeApart MARTypeVsConstraint
-- We don't bother to look inside; wrinkle (W3) in GHC.Builtin.Types.Prim
-- Note [Type and Constraint are not apart]
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -997,7 +997,7 @@ rep_sig (L loc (SpecSig _ nm tys ispec))
= concatMapM (\t -> rep_specialise nm t ispec (locA loc)) tys
rep_sig (L loc (SpecInstSig _ ty)) = rep_specialiseInst ty (locA loc)
rep_sig (L _ (MinimalSig {})) = notHandled ThMinimalPragmas
-rep_sig (L _ (SCCFunSig {})) = notHandled ThSCCPragmas
+rep_sig (L loc (SCCFunSig _ nm str)) = rep_sccFun nm str (locA loc)
rep_sig (L loc (CompleteMatchSig _ cls mty))
= rep_complete_sig cls mty (locA loc)
rep_sig d@(L _ (XSig {})) = pprPanic "rep_sig IdSig" (ppr d)
@@ -1121,6 +1121,21 @@ rep_specialiseInst ty loc
; pragma <- repPragSpecInst ty1
; return [(loc, pragma)] }
+rep_sccFun :: LocatedN Name
+ -> Maybe (XRec GhcRn StringLiteral)
+ -> SrcSpan
+ -> MetaM [(SrcSpan, Core (M TH.Dec))]
+rep_sccFun nm Nothing loc = do
+ nm1 <- lookupLOcc nm
+ scc <- repPragSCCFun nm1
+ return [(loc, scc)]
+
+rep_sccFun nm (Just (L _ str)) loc = do
+ nm1 <- lookupLOcc nm
+ str1 <- coreStringLit (sl_fs str)
+ scc <- repPragSCCFunNamed nm1 str1
+ return [(loc, scc)]
+
repInline :: InlineSpec -> MetaM (Core TH.Inline)
repInline (NoInline _ ) = dataCon noInlineDataConName
-- There is a mismatch between the TH and GHC representation because
@@ -2687,6 +2702,12 @@ repPragRule (MkC nm) (MkC ty_bndrs) (MkC tm_bndrs) (MkC lhs) (MkC rhs) (MkC phas
repPragAnn :: Core TH.AnnTarget -> Core (M TH.Exp) -> MetaM (Core (M TH.Dec))
repPragAnn (MkC targ) (MkC e) = rep2 pragAnnDName [targ, e]
+repPragSCCFun :: Core TH.Name -> MetaM (Core (M TH.Dec))
+repPragSCCFun (MkC nm) = rep2 pragSCCFunDName [nm]
+
+repPragSCCFunNamed :: Core TH.Name -> Core String -> MetaM (Core (M TH.Dec))
+repPragSCCFunNamed (MkC nm) (MkC str) = rep2 pragSCCFunNamedDName [nm, str]
+
repTySynInst :: Core (M TH.TySynEqn) -> MetaM (Core (M TH.Dec))
repTySynInst (MkC eqn)
= rep2 tySynInstDName [eqn]
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -954,6 +954,12 @@ cvtPragmaD (CompleteP cls mty)
; mty' <- traverse tconNameN mty
; returnJustLA $ Hs.SigD noExtField
$ CompleteMatchSig (noAnn, NoSourceText) cls' mty' }
+cvtPragmaD (SCCP nm str) = do
+ nm' <- vcNameN nm
+ str' <- traverse (\s ->
+ returnLA $ StringLiteral NoSourceText (mkFastString s) Nothing) str
+ returnJustLA $ Hs.SigD noExtField
+ $ SCCFunSig (noAnn, SourceText $ fsLit "{-# SCC") nm' str'
dfltActivation :: TH.Inline -> Activation
dfltActivation TH.NoInline = NeverActive
=====================================
compiler/GHC/Types/SourceText.hs
=====================================
@@ -322,4 +322,4 @@ instance Eq StringLiteral where
(StringLiteral _ a _) == (StringLiteral _ b _) = a == b
instance Outputable StringLiteral where
- ppr sl = pprWithSourceText (sl_st sl) (ftext $ sl_fs sl)
+ ppr sl = pprWithSourceText (sl_st sl) (doubleQuotes $ ftext $ sl_fs sl)
=====================================
libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
=====================================
@@ -553,6 +553,12 @@ pragLineD line file = pure $ PragmaD $ LineP line file
pragCompleteD :: Quote m => [Name] -> Maybe Name -> m Dec
pragCompleteD cls mty = pure $ PragmaD $ CompleteP cls mty
+pragSCCFunD :: Quote m => Name -> m Dec
+pragSCCFunD nm = pure $ PragmaD $ SCCP nm Nothing
+
+pragSCCFunNamedD :: Quote m => Name -> String -> m Dec
+pragSCCFunNamedD nm str = pure $ PragmaD $ SCCP nm (Just str)
+
dataInstD :: Quote m => m Cxt -> (Maybe [m (TyVarBndr ())]) -> m Type -> Maybe (m Kind) -> [m Con]
-> [m DerivClause] -> m Dec
dataInstD ctxt mb_bndrs ty ksig cons derivs =
=====================================
libraries/template-haskell/Language/Haskell/TH/Ppr.hs
=====================================
@@ -658,6 +658,8 @@ instance Ppr Pragma where
ppr (CompleteP cls mty)
= text "{-# COMPLETE" <+> (fsep $ punctuate comma $ map (pprName' Applied) cls)
<+> maybe empty (\ty -> dcolon <+> pprName' Applied ty) mty <+> text "#-}"
+ ppr (SCCP nm str)
+ = text "{-# SCC" <+> pprName' Applied nm <+> maybe empty pprString str <+> text "#-}"
------------------------------
instance Ppr Inline where
=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -2629,6 +2629,8 @@ data Pragma = InlineP Name Inline RuleMatch Phases
| LineP Int String
| CompleteP [Name] (Maybe Name)
-- ^ @{ {\-\# COMPLETE C_1, ..., C_i [ :: T ] \#-} }@
+ | SCCP Name (Maybe String)
+ -- ^ @{ {\-\# SCC fun "optional_name" \#-} }@
deriving( Show, Eq, Ord, Data, Generic )
data Inline = NoInline
=====================================
libraries/template-haskell/changelog.md
=====================================
@@ -8,6 +8,8 @@
* Extend `Pat` with `TypeP` and `Exp` with `TypeE`,
introduce functions `typeP` and `typeE` (GHC Proposal #281).
+ * Extend `Pragma` with `SCCP`.
+
## 2.21.0.0
* Record fields now belong to separate `NameSpace`s, keyed by the parent of
=====================================
testsuite/driver/testglobals.py
=====================================
@@ -355,6 +355,9 @@ class TestOptions:
self.ignore_stdout = False
self.ignore_stderr = False
+ # don't use the executable extension
+ self.ignore_extension = False
+
# Backpack test
self.compile_backpack = False
=====================================
testsuite/driver/testlib.py
=====================================
@@ -138,9 +138,6 @@ def no_deps( name, opts):
def skip( name, opts ):
opts.skip = True
-def js_arch() -> bool:
- return arch("javascript");
-
# disable test on JS arch
def js_skip( name, opts ):
if js_arch():
@@ -398,6 +395,18 @@ def ignore_stdout(name, opts):
def ignore_stderr(name, opts):
opts.ignore_stderr = True
+def ignore_extension(name, opts):
+ """
+ Some tests generate files that are not expected to be suffixed with an
+ extension type, such as .exe on windows. This option allows these tests to
+ have finer-grained control over the filename that the testsuite will look
+ for. Examples of such tests are hpc tests which expect a .tix extension and
+ hp2ps tests which expect .hp. For these tests, on windows and without
+ ignoring the extension, the testsuite will look for, e.g., 'foo.exe.tix'
+ instead of 'foo.tix'.
+ """
+ opts.ignore_extension = True
+
def combined_output( name, opts ):
opts.combined_output = True
@@ -811,6 +820,8 @@ KNOWN_OPERATING_SYSTEMS = set([
def exe_extension() -> str:
if config.arch == 'wasm32':
return '.wasm'
+ elif config.os == "mingw32":
+ return '.exe'
return ''
def opsys( os: str ) -> bool:
@@ -829,6 +840,9 @@ def msys( ) -> bool:
def cygwin( ) -> bool:
return config.cygwin
+def js_arch() -> bool:
+ return arch("javascript");
+
def have_vanilla( ) -> bool:
return config.have_vanilla
@@ -1592,6 +1606,10 @@ async def ghci_script( name, way, script):
async def compile( name, way, extra_hc_opts ):
return await do_compile( name, way, False, None, [], [], extra_hc_opts )
+async def compile_artifact( name, way, extra_hc_opts ):
+ # We suppress stderr so that the link output isn't compared
+ return await do_compile( name, way, False, None, [], [], extra_hc_opts, should_link=True, compare_stderr=False )
+
async def compile_fail( name, way, extra_hc_opts ):
return await do_compile( name, way, True, None, [], [], extra_hc_opts )
@@ -1607,9 +1625,6 @@ async def backpack_compile( name, way, extra_hc_opts ):
async def backpack_compile_fail( name, way, extra_hc_opts ):
return await do_compile( name, way, True, None, [], [], extra_hc_opts, backpack=True )
-async def backpack_run( name, way, extra_hc_opts ):
- return await compile_and_run__( name, way, None, [], extra_hc_opts, backpack=True )
-
async def multimod_compile( name, way, top_mod, extra_hc_opts ):
return await do_compile( name, way, False, top_mod, [], [], extra_hc_opts )
@@ -1638,6 +1653,8 @@ async def do_compile(name: TestName,
extra_mods: List[str],
units: List[str],
extra_hc_opts: str,
+ should_link=False,
+ compare_stderr=True,
**kwargs
) -> PassFail:
# print 'Compile only, extra args = ', extra_hc_opts
@@ -1647,7 +1664,7 @@ async def do_compile(name: TestName,
return result
extra_hc_opts = result.hc_opts
- result = await simple_build(name, way, extra_hc_opts, should_fail, top_mod, units, False, True, **kwargs)
+ result = await simple_build(name, way, extra_hc_opts, should_fail, top_mod, units, should_link, True, **kwargs)
if badResult(result):
return result
@@ -1660,7 +1677,7 @@ async def do_compile(name: TestName,
actual_stderr_file = add_suffix(name, 'comp.stderr')
diff_file_name = in_testdir(add_suffix(name, 'comp.diff'))
- if not await compare_outputs(way, 'stderr',
+ if compare_stderr and not await compare_outputs(way, 'stderr',
join_normalisers(getTestOpts().extra_errmsg_normaliser,
normalise_errmsg),
expected_stderr_file, actual_stderr_file,
@@ -1762,7 +1779,8 @@ async def compile_and_run__(name: TestName,
extra_mods: List[str],
extra_hc_opts: str,
backpack: bool=False,
- compile_stderr: bool=False
+ compile_stderr: bool=False,
+ use_extension: bool=True
) -> PassFail:
# print 'Compile and run, extra args = ', extra_hc_opts
@@ -1795,8 +1813,11 @@ async def compile_and_run__(name: TestName,
stderr = diff_file_name.read_text()
diff_file_name.unlink()
return failBecause('ghc.stderr mismatch', stderr=stderr)
-#
- cmd = './' + name + exe_extension()
+
+ opts = getTestOpts()
+ extension = exe_extension() if not opts.ignore_extension else ""
+
+ cmd = './' + name + extension
# we don't check the compiler's stderr for a compile-and-run test
return await simple_run( name, way, cmd, getTestOpts().extra_run_opts )
@@ -1804,6 +1825,9 @@ async def compile_and_run__(name: TestName,
async def compile_and_run( name, way, extra_hc_opts ):
return await compile_and_run__( name, way, None, [], extra_hc_opts)
+async def backpack_run( name, way, extra_hc_opts ):
+ return await compile_and_run__( name, way, None, [], extra_hc_opts, backpack=True )
+
async def multimod_compile_and_run( name, way, top_mod, extra_hc_opts ):
return await compile_and_run__( name, way, top_mod, [], extra_hc_opts)
@@ -2310,8 +2334,8 @@ def write_file(f: Path, s: str) -> None:
# operate on bytes.
async def check_hp_ok(name: TestName) -> bool:
- actual_name = name + exe_extension()
opts = getTestOpts()
+ actual_name = name + exe_extension() if not opts.ignore_extension else name
# do not qualify for hp2ps because we should be in the right directory
hp2psCmd = 'cd "{opts.testdir}" && {{hp2ps}} {actual_name}'.format(**locals())
=====================================
testsuite/tests/hpc/function/test.T
=====================================
@@ -5,5 +5,6 @@ hpc_prefix = "perl hpcrun.pl --clear --exeext={exeext} --hpc={hpc}"
test('tough',
[extra_files(['../hpcrun.pl']),
cmd_prefix(hpc_prefix),
+ ignore_extension,
when(arch('wasm32'), fragile(23243))],
compile_and_run, ['-fhpc'])
=====================================
testsuite/tests/hpc/function2/test.T
=====================================
@@ -10,6 +10,7 @@ test('tough2',
[extra_files(['../hpcrun.pl', 'subdir/']),
literate,
cmd_prefix(hpc_prefix),
+ ignore_extension,
omit_ways(ghci_ways + prof_ways), # profile goes in the wrong place
when(arch('wasm32'), fragile(23243)) ],
multimod_compile_and_run, ['subdir/tough2.lhs', '-fhpc'])
=====================================
testsuite/tests/hpc/simple/test.T
=====================================
@@ -3,6 +3,7 @@ setTestOpts([omit_ghci, when(fast(), skip), js_skip])
hpc_prefix = "perl hpcrun.pl --clear --exeext={exeext} --hpc={hpc}"
test('hpc001', [extra_files(['../hpcrun.pl']), cmd_prefix(hpc_prefix),
- when(arch('wasm32'), fragile(23243))
+ when(arch('wasm32'), fragile(23243)),
+ ignore_extension
],
compile_and_run, ['-fhpc'])
=====================================
testsuite/tests/perf/size/all.T
=====================================
@@ -1,3 +1,6 @@
test('size_hello_obj', [collect_size(5, 'size_hello_obj.o')], compile, [''])
+test('size_hello_artifact', [collect_size(5, 'size_hello_artifact' + exe_extension())],
+ compile_artifact, [''])
+
test('libdir',[collect_size_dir(10, config.libdir)], static_stats, [] )
=====================================
testsuite/tests/perf/size/size_hello_artifact.hs
=====================================
@@ -0,0 +1,4 @@
+-- same as size_hello_obj but we test the size of the resulting executable.
+module Main where
+
+main = print "Hello World!"
=====================================
testsuite/tests/profiling/should_run/all.T
=====================================
@@ -4,6 +4,7 @@ setTestOpts(js_skip) # JS backend doesn't support profiling yet
test('heapprof002',
[extra_files(['heapprof001.hs']),
+ ignore_extension,
pre_cmd('cp heapprof001.hs heapprof002.hs'), extra_ways(['normal_h']),
extra_run_opts('7')],
compile_and_run, [''])
=====================================
testsuite/tests/th/should_compile/T24081/Main.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+import TH
+
+x
+y
+a = 1
+b = 1
+gen
+
+main = return ()
=====================================
testsuite/tests/th/should_compile/T24081/Makefile
=====================================
@@ -0,0 +1,3 @@
+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
=====================================
testsuite/tests/th/should_compile/T24081/T24081.stderr
=====================================
@@ -0,0 +1,15 @@
+Main.hs:5:1: Splicing declarations
+ x
+ ======>
+ {-# SCC f #-}
+ f = 1
+Main.hs:6:1: Splicing declarations
+ y
+ ======>
+ {-# SCC g "custom_name_g" #-}
+ g = 1
+Main.hs:9:1-3: Splicing declarations
+ gen
+ ======>
+ {-# SCC a #-}
+ {-# SCC b "custom_name_b" #-}
=====================================
testsuite/tests/th/should_compile/T24081/TH.hs
=====================================
@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+module TH where
+
+import Data.Maybe
+import Language.Haskell.TH
+
+x, y :: Q [Dec]
+x = [d|{-# SCC f #-}; f = 1|]
+y = [d|{-# SCC g "custom_name_g" #-}; g = 1|]
+
+gen :: Q [Dec]
+gen = do
+ a <- fromJust <$> lookupValueName "a"
+ b <- fromJust <$> lookupValueName "b"
+ pure
+ [ PragmaD $ SCCP a Nothing
+ , PragmaD $ SCCP b (Just "custom_name_b")
+ ]
=====================================
testsuite/tests/th/should_compile/T24081/all.T
=====================================
@@ -0,0 +1,2 @@
+test('T24081', [extra_files(['TH.hs', 'Main.hs']), req_th],
+ multimod_compile, ['TH Main', '-v0 -ddump-splices -dsuppress-uniques'])
=====================================
testsuite/tests/typecheck/should_fail/T24279.hs
=====================================
@@ -0,0 +1,31 @@
+{-# LANGUAGE TypeFamilies #-}
+module T24279 where
+
+import GHC.Exts
+import Data.Kind
+
+type F :: (RuntimeRep -> Type) -> Type
+type family F a where
+ F TYPE = Int
+ F CONSTRAINT = Bool
+
+type G :: Type -> RuntimeRep -> Type
+type family G a where
+ G (a b) = a
+
+-- Should be rejected
+foo :: (F (G Constraint)) -> Bool
+foo x = x
+
+
+type family H a b where
+ H a a = Int
+ H a b = Bool
+
+-- Should be rejected
+bar1 :: H TYPE CONSTRAINT -> Int
+bar1 x = x
+
+-- Should be rejected
+bar2 :: H Type Constraint -> Int
+bar2 x = x
=====================================
testsuite/tests/typecheck/should_fail/T24279.stderr
=====================================
@@ -0,0 +1,19 @@
+
+T24279.hs:18:9: error: [GHC-83865]
+ • Couldn't match type ‘F CONSTRAINT’ with ‘Bool’
+ Expected: Bool
+ Actual: F (G Constraint)
+ • In the expression: x
+ In an equation for ‘foo’: foo x = x
+
+T24279.hs:27:10: error: [GHC-83865]
+ • Couldn't match expected type ‘Int’
+ with actual type ‘H TYPE CONSTRAINT’
+ • In the expression: x
+ In an equation for ‘bar1’: bar1 x = x
+
+T24279.hs:31:10: error: [GHC-83865]
+ • Couldn't match expected type ‘Int’
+ with actual type ‘H (*) Constraint’
+ • In the expression: x
+ In an equation for ‘bar2’: bar2 x = x
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -711,3 +711,4 @@ test('T17940', normal, compile_fail, [''])
test('ErrorIndexLinks', normal, compile_fail, ['-fprint-error-index-links=always'])
test('T24064', normal, compile_fail, [''])
test('T24298', normal, compile_fail, [''])
+test('T24279', normal, compile_fail, [''])
=====================================
testsuite/tests/typecheck/testeq1/test.T
=====================================
@@ -1,6 +1,7 @@
test('typecheck.testeq1', [ extra_files(['FakePrelude.hs', 'Main.hs', 'TypeCast.hs', 'TypeEq.hs'])
, when(fast(), skip)
+ , ignore_extension
, js_broken(22355)
# https://gitlab.haskell.org/ghc/ghc/-/issues/23238
, when(arch('wasm32'), skip)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29aeb0f8ea9be0c06a119226617fb85506392339...d674013407774f2a94213459c47b626fdd3d4265
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29aeb0f8ea9be0c06a119226617fb85506392339...d674013407774f2a94213459c47b626fdd3d4265
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/20240110/6df40ec7/attachment-0001.html>
More information about the ghc-commits
mailing list