[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: compiler: Ensure that GHC toolchain is first in search path
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sat Dec 24 19:49:19 UTC 2022
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00
compiler: Ensure that GHC toolchain is first in search path
As noted in #22561, it is important that GHC's toolchain look
first for its own headers and libraries to ensure that the
system's are not found instead. If this happens things can
break in surprising ways (e.g. see #22561).
- - - - -
cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00
head.hackage: Use slow-validate bindist for linting jobs
This enables the SLOW_VALIDATE env var for the linting head.hackage
jobs, namely the jobs enabled manually, by the label or on the nightly
build now use the deb10-numa-slow-validate bindist which has assertions
enabled.
See #22623 for a ticket which was found by using this configuration
already!
The head.hackage jobs triggered by upstream CI are now thusly:
hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build.
Runs head.hackage with -dlint and a slow-validate bindist
hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate
head.hackage build with -dlint.
nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config.
nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled.
release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist.
- - - - -
f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00
ci: Don't run abi-test-nightly on release jobs
The test is not configured to get the correct dependencies for the
release pipelines (and indeed stops the release pipeline being run at
all)
- - - - -
c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00
ci: Run head.hackage jobs on upstream-testing branch rather than master
This change allows less priviledged users to trigger head.hackage jobs
because less permissions are needed to trigger jobs on the
upstream-testing branch, which is not protected.
There is a CI job which updates upstream-testing each hour to the state
of the master branch so it should always be relatively up-to-date.
- - - - -
63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00
llvmGen: Fix relaxed ordering
Previously I used LLVM's `unordered` ordering for the C11 `relaxed`
ordering. However, this is wrong and should rather use the LLVM
`monotonic` ordering.
Fixes #22640
- - - - -
f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00
gitlab-ci: Introduce aarch64-linux-llvm job
This nightly job will ensure that we don't break the LLVM backend on
AArch64/Linux by bootstrapping GHC.
This would have caught #22640.
- - - - -
6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00
Store RdrName rather than OccName in Holes
In #20472 it was pointed out that you couldn't defer out of scope but
the implementation collapsed a RdrName into an OccName to stuff it into
a Hole. This leads to the error message for a deferred qualified name
dropping the qualification which affects the quality of the error
message.
This commit adds a bit more structure to a hole, so a hole can replace a
RdrName without losing information about what that RdrName was. This is
important when printing error messages.
I also added a test which checks the Template Haskell deferral of out of
scope qualified names works properly.
Fixes #22130
- - - - -
46baf501 by Ben Gamari at 2022-12-24T14:48:56-05:00
hadrian: Ensure that linker scripts are used when merging objects
In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's
implementation of the object merging rules: unlike the old `make` build
system we utterly failed to pass the needed linker scripts. Fix this.
- - - - -
dcdc3b99 by Bodigrim at 2022-12-24T14:48:58-05:00
Document infelicities of instance Ord Double and workarounds
- - - - -
27 changed files:
- .gitlab-ci.yml
- .gitlab/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Settings/IO.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- hadrian/src/Flavour.hs
- libraries/ghc-prim/GHC/Classes.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- m4/fp_settings.m4
- testsuite/tests/perf/compiler/hard_hole_fits.stderr
- testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs
- + testsuite/tests/quotes/T20472_quotes.hs
- testsuite/tests/quotes/all.T
- testsuite/tests/rename/should_compile/T20472.stderr
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -481,7 +481,6 @@ abi-test-nightly:
- out
rules:
- if: $NIGHTLY
- - if: '$RELEASE_JOB == "yes"'
############################################################
# Packaging
@@ -679,19 +678,21 @@ test-bootstrap:
# access to an unprivileged access token with the ability to query the ghc/ghc
# project such that it can find the job ID of the fedora33 job for the current
# pipeline.
+#
+# hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build.
+# Runs head.hackage with -dlint and a slow-validate bindist
+#
+# hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate
+# head.hackage build with -dlint.
+#
+# nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config.
+#
+# nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled.
+#
+# release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist.
.hackage:
stage: testing
- needs:
- - job: x86_64-linux-fedora33-release
- optional: true
- artifacts: false
- - job: nightly-x86_64-linux-fedora33-release
- optional: true
- artifacts: false
- - job: release-x86_64-linux-fedora33-release
- optional: true
- artifacts: false
variables:
UPSTREAM_PROJECT_PATH: "$CI_PROJECT_PATH"
UPSTREAM_PROJECT_ID: "$CI_PROJECT_ID"
@@ -699,34 +700,60 @@ test-bootstrap:
RELEASE_JOB: "$RELEASE_JOB"
trigger:
project: "ghc/head.hackage"
- branch: "master"
+ branch: "upstream-testing"
strategy: "depend"
hackage-lint:
+ needs:
+ - job: x86_64-linux-deb10-numa-slow-validate
+ optional: true
+ artifacts: false
+ - job: nightly-x86_64-linux-deb10-numa-slow-validate
+ optional: true
+ artifacts: false
extends: .hackage
variables:
- EXTRA_HC_OPTS: "-dcore-lint"
+ SLOW_VALIDATE: 1
+ EXTRA_HC_OPTS: "-dlint"
+ # No for release jobs because there isn't a slow-valdate bindist. There is an
+ # automatic pipeline for release bindists (see release-hackage-lint)
+ rules:
+ - if: '$RELEASE_JOB != "yes"'
when: manual
hackage-label-lint:
+ needs:
+ - job: x86_64-linux-deb10-numa-slow-validate
+ optional: true
+ artifacts: false
extends: .hackage
variables:
- EXTRA_HC_OPTS: "-dcore-lint"
+ SLOW_VALIDATE: 1
+ EXTRA_HC_OPTS: "-dlint"
rules:
- if: '$CI_MERGE_REQUEST_LABELS =~ /.*user-facing.*/'
-# The head.hackage job is split into two jobs because enabling `-dcore-lint`
+# The head.hackage job is split into two jobs because enabling `-dlint`
# affects the total allocation numbers for the simplifier portion significantly.
nightly-hackage-lint:
+ needs:
+ - job: nightly-x86_64-linux-deb10-numa-slow-validate
+ optional: true
+ artifacts: false
rules:
- if: $NIGHTLY
variables:
NIGHTLY: "$NIGHTLY"
extends: .hackage
variables:
- EXTRA_HC_OPTS: "-dcore-lint"
+ SLOW_VALIDATE: 1
+ EXTRA_HC_OPTS: "-dlint"
nightly-hackage-perf:
+ needs:
+ - job: nightly-x86_64-linux-fedora33-release
+ optional: true
+ artifacts: false
rules:
- if: $NIGHTLY
variables:
@@ -738,6 +765,18 @@ nightly-hackage-perf:
# Ask head.hackage to generate eventlogs
EVENTLOGGING: 1
+release-hackage-lint:
+ needs:
+ - job: release-x86_64-linux-fedora33-release
+ optional: true
+ artifacts: false
+ rules:
+ - if: '$RELEASE_JOB == "yes"'
+ extends: .hackage
+ variables:
+ # No slow-validate bindist on release pipeline
+ EXTRA_HC_OPTS: "-dlint"
+
############################################################
# Nofib testing
# (Disabled: See #21859)
=====================================
.gitlab/gen_ci.hs
=====================================
@@ -807,6 +807,7 @@ jobs = Map.fromList $ concatMap flattenJobGroup $
, allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13))
, standardBuilds AArch64 Darwin
, standardBuilds AArch64 (Linux Debian10)
+ , disableValidate (standardBuildsWithConfig AArch64 (Linux Debian10) llvm)
, standardBuilds I386 (Linux Debian9)
, standardBuildsWithConfig Amd64 (Linux Alpine) static
, disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt))
=====================================
.gitlab/jobs.yaml
=====================================
@@ -120,6 +120,64 @@
"TEST_ENV": "aarch64-linux-deb10-validate"
}
},
+ "aarch64-linux-deb10-validate+llvm": {
+ "after_script": [
+ ".gitlab/ci.sh save_cache",
+ ".gitlab/ci.sh clean",
+ "cat ci_timings"
+ ],
+ "allow_failure": false,
+ "artifacts": {
+ "expire_in": "2 weeks",
+ "paths": [
+ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz",
+ "junit.xml"
+ ],
+ "reports": {
+ "junit": "junit.xml"
+ },
+ "when": "always"
+ },
+ "cache": {
+ "key": "aarch64-linux-deb10-$CACHE_REV",
+ "paths": [
+ "cabal-cache",
+ "toolchain"
+ ]
+ },
+ "dependencies": [],
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV",
+ "needs": [
+ {
+ "artifacts": false,
+ "job": "hadrian-ghc-in-ghci"
+ }
+ ],
+ "rules": [
+ {
+ "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")",
+ "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": [
+ "aarch64-linux"
+ ],
+ "variables": {
+ "BIGNUM_BACKEND": "gmp",
+ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm",
+ "BUILD_FLAVOUR": "validate+llvm",
+ "CONFIGURE_ARGS": "",
+ "TEST_ENV": "aarch64-linux-deb10-validate+llvm"
+ }
+ },
"i386-linux-deb9-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
@@ -300,6 +358,65 @@
"XZ_OPT": "-9"
}
},
+ "nightly-aarch64-linux-deb10-validate+llvm": {
+ "after_script": [
+ ".gitlab/ci.sh save_cache",
+ ".gitlab/ci.sh clean",
+ "cat ci_timings"
+ ],
+ "allow_failure": false,
+ "artifacts": {
+ "expire_in": "8 weeks",
+ "paths": [
+ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz",
+ "junit.xml"
+ ],
+ "reports": {
+ "junit": "junit.xml"
+ },
+ "when": "always"
+ },
+ "cache": {
+ "key": "aarch64-linux-deb10-$CACHE_REV",
+ "paths": [
+ "cabal-cache",
+ "toolchain"
+ ]
+ },
+ "dependencies": [],
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV",
+ "needs": [
+ {
+ "artifacts": false,
+ "job": "hadrian-ghc-in-ghci"
+ }
+ ],
+ "rules": [
+ {
+ "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")",
+ "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": [
+ "aarch64-linux"
+ ],
+ "variables": {
+ "BIGNUM_BACKEND": "gmp",
+ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm",
+ "BUILD_FLAVOUR": "validate+llvm",
+ "CONFIGURE_ARGS": "",
+ "TEST_ENV": "aarch64-linux-deb10-validate+llvm",
+ "XZ_OPT": "-9"
+ }
+ },
"nightly-i386-linux-deb9-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
@@ -1869,6 +1986,66 @@
"XZ_OPT": "-9"
}
},
+ "release-aarch64-linux-deb10-release+llvm": {
+ "after_script": [
+ ".gitlab/ci.sh save_cache",
+ ".gitlab/ci.sh clean",
+ "cat ci_timings"
+ ],
+ "allow_failure": false,
+ "artifacts": {
+ "expire_in": "1 year",
+ "paths": [
+ "ghc-aarch64-linux-deb10-release+llvm.tar.xz",
+ "junit.xml"
+ ],
+ "reports": {
+ "junit": "junit.xml"
+ },
+ "when": "always"
+ },
+ "cache": {
+ "key": "aarch64-linux-deb10-$CACHE_REV",
+ "paths": [
+ "cabal-cache",
+ "toolchain"
+ ]
+ },
+ "dependencies": [],
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV",
+ "needs": [
+ {
+ "artifacts": false,
+ "job": "hadrian-ghc-in-ghci"
+ }
+ ],
+ "rules": [
+ {
+ "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")",
+ "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": [
+ "aarch64-linux"
+ ],
+ "variables": {
+ "BIGNUM_BACKEND": "gmp",
+ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-release+llvm",
+ "BUILD_FLAVOUR": "release+llvm",
+ "CONFIGURE_ARGS": "",
+ "IGNORE_PERF_FAILURES": "all",
+ "TEST_ENV": "aarch64-linux-deb10-release+llvm",
+ "XZ_OPT": "-9"
+ }
+ },
"release-i386-linux-deb9-release": {
"after_script": [
".gitlab/ci.sh save_cache",
=====================================
compiler/GHC/Builtin/Names/TH.hs
=====================================
@@ -32,7 +32,7 @@ templateHaskellNames :: [Name]
templateHaskellNames = [
returnQName, bindQName, sequenceQName, newNameName, liftName, liftTypedName,
mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
- mkNameSName,
+ mkNameSName, mkNameQName,
mkModNameName,
liftStringName,
unTypeName, unTypeCodeName,
@@ -216,7 +216,7 @@ modNameTyConName = thTc (fsLit "ModName") modNameTyConKey
returnQName, bindQName, sequenceQName, newNameName, liftName,
mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
mkNameLName, mkNameSName, liftStringName, unTypeName, unTypeCodeName,
- unsafeCodeCoerceName, liftTypedName, mkModNameName :: Name
+ unsafeCodeCoerceName, liftTypedName, mkModNameName, mkNameQName :: Name
returnQName = thFun (fsLit "returnQ") returnQIdKey
bindQName = thFun (fsLit "bindQ") bindQIdKey
sequenceQName = thFun (fsLit "sequenceQ") sequenceQIdKey
@@ -228,6 +228,7 @@ mkNameG_vName = thFun (fsLit "mkNameG_v") mkNameG_vIdKey
mkNameG_dName = thFun (fsLit "mkNameG_d") mkNameG_dIdKey
mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey
mkNameLName = thFun (fsLit "mkNameL") mkNameLIdKey
+mkNameQName = thFun (fsLit "mkNameQ") mkNameQIdKey
mkNameSName = thFun (fsLit "mkNameS") mkNameSIdKey
mkModNameName = thFun (fsLit "mkModName") mkModNameIdKey
unTypeName = thFun (fsLit "unType") unTypeIdKey
@@ -742,7 +743,7 @@ incoherentDataConKey = mkPreludeDataConUnique 212
returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,
mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,
mkNameLIdKey, mkNameSIdKey, unTypeIdKey, unTypeCodeIdKey,
- unsafeCodeCoerceIdKey, liftTypedIdKey, mkModNameIdKey :: Unique
+ unsafeCodeCoerceIdKey, liftTypedIdKey, mkModNameIdKey, mkNameQIdKey :: Unique
returnQIdKey = mkPreludeMiscIdUnique 200
bindQIdKey = mkPreludeMiscIdUnique 201
sequenceQIdKey = mkPreludeMiscIdUnique 202
@@ -759,6 +760,7 @@ unTypeCodeIdKey = mkPreludeMiscIdUnique 212
liftTypedIdKey = mkPreludeMiscIdUnique 214
mkModNameIdKey = mkPreludeMiscIdUnique 215
unsafeCodeCoerceIdKey = mkPreludeMiscIdUnique 216
+mkNameQIdKey = mkPreludeMiscIdUnique 217
-- data Lit = ...
=====================================
compiler/GHC/CmmToLlvm/CodeGen.hs
=====================================
@@ -2030,7 +2030,7 @@ genLit _ CmmHighStackMark
--
convertMemoryOrdering :: MemoryOrdering -> LlvmSyncOrdering
-convertMemoryOrdering MemOrderRelaxed = SyncUnord
+convertMemoryOrdering MemOrderRelaxed = SyncMonotonic
convertMemoryOrdering MemOrderAcquire = SyncAcquire
convertMemoryOrdering MemOrderRelease = SyncRelease
convertMemoryOrdering MemOrderSeqCst = SyncSeqCst
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -99,6 +99,7 @@ import Data.Function
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class
import Data.Foldable ( toList )
+import GHC.Types.Name.Reader (RdrName(..))
data MetaWrappers = MetaWrappers {
-- Applies its argument to a type argument `m` and dictionary `Quote m`
@@ -1647,9 +1648,8 @@ repE (HsUntypedSplice (HsUntypedSpliceNested n) _) = rep_splice n
repE e@(HsUntypedSplice (HsUntypedSpliceTop _ _) _) = pprPanic "repE: top level splice" (ppr e)
repE (HsStatic _ e) = repLE e >>= rep2 staticEName . (:[]) . unC
repE (HsUnboundVar _ uv) = do
- occ <- occNameLit uv
- sname <- repNameS occ
- repUnboundVar sname
+ name <- repRdrName uv
+ repUnboundVar name
repE (HsGetField _ e (L _ (DotFieldOcc _ (L _ (FieldLabelString f))))) = do
e1 <- repLE e
repGetField e1 f
@@ -2191,31 +2191,40 @@ lookupOccDsM n
Just (DsSplice _) -> pprPanic "repE:lookupOcc" (ppr n)
}
-globalVar :: Name -> DsM (Core TH.Name)
+
-- Not bound by the meta-env
-- Could be top-level; or could be local
-- f x = $(g [| x |])
-- Here the x will be local
-globalVar name
- | isExternalName name
- = do { MkC mod <- coreStringLit name_mod
- ; MkC pkg <- coreStringLit name_pkg
- ; MkC occ <- nameLit name
- ; rep2_nwDsM mk_varg [pkg,mod,occ] }
- | otherwise
- = do { MkC occ <- nameLit name
+globalVar :: Name -> DsM (Core TH.Name)
+globalVar n =
+ case nameModule_maybe n of
+ Just m -> globalVarExternal m (getOccName n)
+ Nothing -> globalVarLocal (getUnique n) (getOccName n)
+
+globalVarLocal :: Unique -> OccName -> DsM (Core TH.Name)
+globalVarLocal unique name
+ = do { MkC occ <- occNameLit name
; platform <- targetPlatform <$> getDynFlags
- ; let uni = mkIntegerExpr platform (toInteger $ getKey (getUnique name))
+ ; let uni = mkIntegerExpr platform (toInteger $ getKey unique)
; rep2_nwDsM mkNameLName [occ,uni] }
+
+globalVarExternal :: Module -> OccName -> DsM (Core TH.Name)
+globalVarExternal mod name_occ
+ = do {
+
+ ; MkC mod <- coreStringLit name_mod
+ ; MkC pkg <- coreStringLit name_pkg
+ ; MkC occ <- occNameLit name_occ
+ ; rep2_nwDsM mk_varg [pkg,mod,occ] }
where
- mod = assert (isExternalName name) nameModule name
- name_mod = moduleNameFS (moduleName mod)
- name_pkg = unitFS (moduleUnit mod)
- name_occ = nameOccName name
- mk_varg | isDataOcc name_occ = mkNameG_dName
- | isVarOcc name_occ = mkNameG_vName
- | isTcOcc name_occ = mkNameG_tcName
- | otherwise = pprPanic "GHC.HsToCore.Quote.globalVar" (ppr name)
+ name_mod = moduleNameFS (moduleName mod)
+ name_pkg = unitFS (moduleUnit mod)
+ mk_varg | isDataOcc name_occ = mkNameG_dName
+ | isVarOcc name_occ = mkNameG_vName
+ | isTcOcc name_occ = mkNameG_tcName
+ | otherwise = pprPanic "GHC.HsToCore.Quote.globalVar" (ppr name_occ)
+
lookupType :: Name -- Name of type constructor (e.g. (M TH.Exp))
-> MetaM Type -- The type
@@ -2243,15 +2252,12 @@ wrapGenSyms binds body@(MkC b)
go _ [] = return body
go var_ty ((name,id) : binds)
= do { MkC body' <- go var_ty binds
- ; lit_str <- lift $ nameLit name
+ ; lit_str <- occNameLit (occName name)
; gensym_app <- repGensym lit_str
; repBindM var_ty elt_ty
gensym_app (MkC (Lam id body')) }
-nameLit :: Name -> DsM (Core String)
-nameLit n = coreStringLit (occNameFS (nameOccName n))
-
-occNameLit :: OccName -> MetaM (Core String)
+occNameLit :: MonadThings m => OccName -> m (Core String)
occNameLit name = coreStringLit (occNameFS name)
@@ -2945,9 +2951,25 @@ mk_lit (HsIntegral i) = mk_integer (il_value i)
mk_lit (HsFractional f) = mk_rational f
mk_lit (HsIsString _ s) = mk_string s
+repRdrName :: RdrName -> MetaM (Core TH.Name)
+repRdrName rdr_name = do
+ case rdr_name of
+ Unqual occ ->
+ repNameS =<< occNameLit occ
+ Qual mn occ -> do
+ let name_mod = moduleNameFS mn
+ mod <- coreStringLit name_mod
+ occ <- occNameLit occ
+ repNameQ mod occ
+ Orig m n -> lift $ globalVarExternal m n
+ Exact n -> lift $ globalVar n
+
repNameS :: Core String -> MetaM (Core TH.Name)
repNameS (MkC name) = rep2_nw mkNameSName [name]
+repNameQ :: Core String -> Core String -> MetaM (Core TH.Name)
+repNameQ (MkC mn) (MkC name) = rep2_nw mkNameQName [mn, name]
+
--------------- Miscellaneous -------------------
repGensym :: Core String -> MetaM (Core (M TH.Name))
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1815,7 +1815,7 @@ instance DisambECP (HsExpr GhcPs) where
rejectPragmaPV _ = return ()
hsHoleExpr :: EpAnn EpAnnUnboundVar -> HsExpr GhcPs
-hsHoleExpr anns = HsUnboundVar anns (mkVarOccFS (fsLit "_"))
+hsHoleExpr anns = HsUnboundVar anns (mkRdrUnqual (mkVarOccFS (fsLit "_")))
type instance Anno (GRHS GhcPs (LocatedA (PatBuilder GhcPs))) = SrcAnn NoEpAnns
type instance Anno [LocatedA (Match GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnL
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -248,8 +248,9 @@ finishHsVar (L l name)
rnUnboundVar :: RdrName -> RnM (HsExpr GhcRn, FreeVars)
rnUnboundVar v = do
deferOutofScopeVariables <- goptM Opt_DeferOutOfScopeVariables
+ -- See Note [Reporting unbound names] for difference between qualified and unqualified names.
unless (isUnqual v || deferOutofScopeVariables) (reportUnboundName v >> return ())
- return (HsUnboundVar noExtField (rdrNameOcc v), emptyFVs)
+ return (HsUnboundVar noExtField v, emptyFVs)
rnExpr (HsVar _ (L l v))
= do { dflags <- getDynFlags
@@ -751,6 +752,28 @@ bindNonRec will automatically do the right thing, giving us:
case expr of y -> (\x -> op y x)
See #18151.
+
+Note [Reporting unbound names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Faced with an out-of-scope `RdrName` there are two courses of action
+A. Report an error immediately (and return a HsUnboundVar). This will halt GHC after the renamer is complete
+B. Return a HsUnboundVar without reporting an error. That will allow the typechecker to run, which in turn
+ can give a better error message, notably giving the type of the variable via the "typed holes" mechanism.
+
+When `-fdefer-out-of-scope-variables` is on we follow plan B.
+
+When it is not, we follow plan B for unqualified names, and plan A for qualified names.
+
+If a name is qualified, and out of scope, then by default an error will be raised
+because the user was already more precise. They specified a specific qualification
+and either
+ * The qualification didn't exist, so that precision was wrong.
+ * Or the qualification existed and the thing we were looking for wasn't where
+ the qualification said it would be.
+
+However we can still defer this error completely, and we do defer it if
+`-fdefer-out-of-scope-variables` is enabled.
+
-}
{-
=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -1425,7 +1425,7 @@ data NegationHandling = ReassociateNegation | KeepNegationIntact
-- | Name of an operator in an operator application or section
data OpName = NormalOp Name -- ^ A normal identifier
| NegateOp -- ^ Prefix negation
- | UnboundOp OccName -- ^ An unbound identifier
+ | UnboundOp RdrName -- ^ An unbound identifier
| RecFldOp (FieldOcc GhcRn) -- ^ A record field occurrence
instance Outputable OpName where
@@ -1607,7 +1607,7 @@ checkSectionPrec direction section op arg
lookupFixityOp :: OpName -> RnM Fixity
lookupFixityOp (NormalOp n) = lookupFixityRn n
lookupFixityOp NegateOp = lookupFixityRn negateName
-lookupFixityOp (UnboundOp u) = lookupFixityRn (mkUnboundName u)
+lookupFixityOp (UnboundOp u) = lookupFixityRn (mkUnboundName (occName u))
lookupFixityOp (RecFldOp f) = lookupFieldFixityRn f
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -1370,8 +1370,7 @@ badRuleLhsErr name lhs bad_e
err =
case bad_e of
HsUnboundVar _ uv ->
- let rdr = mkRdrUnqual uv
- in pprScopeError rdr $ notInScopeErr WL_Global (mkRdrUnqual uv)
+ pprScopeError uv $ notInScopeErr WL_Global uv
_ -> text "Illegal expression:" <+> ppr bad_e
{- **************************************************************
=====================================
compiler/GHC/Settings/IO.hs
=====================================
@@ -79,11 +79,11 @@ initSettings top_dir = do
myExtraGccViaCFlags <- getSetting "GCC extra via C opts"
cc_prog <- getToolSetting "C compiler command"
cxx_prog <- getToolSetting "C++ compiler command"
- cc_args_str <- getSetting "C compiler flags"
- cxx_args_str <- getSetting "C++ compiler flags"
+ cc_args_str <- getToolSetting "C compiler flags"
+ cxx_args_str <- getToolSetting "C++ compiler flags"
gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie"
cpp_prog <- getToolSetting "Haskell CPP command"
- cpp_args_str <- getSetting "Haskell CPP flags"
+ cpp_args_str <- getToolSetting "Haskell CPP flags"
platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings
@@ -123,13 +123,13 @@ initSettings top_dir = do
-- Other things being equal, as and ld are simply gcc
- cc_link_args_str <- getSetting "C compiler link flags"
+ cc_link_args_str <- getToolSetting "C compiler link flags"
let as_prog = cc_prog
as_args = map Option cc_args
ld_prog = cc_prog
ld_args = map Option (cc_args ++ words cc_link_args_str)
ld_r_prog <- getToolSetting "Merge objects command"
- ld_r_args <- getSetting "Merge objects flags"
+ ld_r_args <- getToolSetting "Merge objects flags"
let ld_r
| null ld_r_prog = Nothing
| otherwise = Just (ld_r_prog, map Option $ words ld_r_args)
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -1347,7 +1347,7 @@ mkHoleError _ _tidy_simples ctxt hole@(Hole { hole_occ = occ, hole_loc = ct_loc
; let (imp_errs, hints)
= unknownNameSuggestions WL_Anything
dflags hpt curr_mod rdr_env
- (tcl_rdr lcl_env) imp_info (mkRdrUnqual occ)
+ (tcl_rdr lcl_env) imp_info occ
err = SolverReportWithCtxt ctxt (ReportHoleError hole $ OutOfScopeHole imp_errs)
report = SolverReport err [] hints
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -3360,14 +3360,14 @@ pprSameOccInfo (SameOcc same_pkg n1 n2) =
**********************************************************************-}
pprHoleError :: SolverReportErrCtxt -> Hole -> HoleError -> SDoc
-pprHoleError _ (Hole { hole_ty, hole_occ = occ }) (OutOfScopeHole imp_errs)
+pprHoleError _ (Hole { hole_ty, hole_occ = rdr }) (OutOfScopeHole imp_errs)
= out_of_scope_msg $$ vcat (map ppr imp_errs)
where
- herald | isDataOcc occ = text "Data constructor not in scope:"
+ herald | isDataOcc (rdrNameOcc rdr) = text "Data constructor not in scope:"
| otherwise = text "Variable not in scope:"
out_of_scope_msg -- Print v :: ty only if the type has structure
- | boring_type = hang herald 2 (ppr occ)
- | otherwise = hang herald 2 (pp_occ_with_type occ hole_ty)
+ | boring_type = hang herald 2 (ppr rdr)
+ | otherwise = hang herald 2 (pp_rdr_with_type rdr hole_ty)
boring_type = isTyVarTy hole_ty
pprHoleError ctxt (Hole { hole_ty, hole_occ}) (HoleError sort other_tvs hole_skol_info) =
vcat [ hole_msg
@@ -3379,7 +3379,7 @@ pprHoleError ctxt (Hole { hole_ty, hole_occ}) (HoleError sort other_tvs hole_sko
hole_msg = case sort of
ExprHole {} ->
hang (text "Found hole:")
- 2 (pp_occ_with_type hole_occ hole_ty)
+ 2 (pp_rdr_with_type hole_occ hole_ty)
TypeHole ->
hang (text "Found type wildcard" <+> quotes (ppr hole_occ))
2 (text "standing for" <+> quotes pp_hole_type_with_kind)
@@ -3404,7 +3404,7 @@ pprHoleError ctxt (Hole { hole_ty, hole_occ}) (HoleError sort other_tvs hole_sko
-- Coercion variables can be free in the
-- hole, via kind casts
expr_hole_hint -- Give hint for, say, f x = _x
- | lengthFS (occNameFS hole_occ) > 1 -- Don't give this hint for plain "_"
+ | lengthFS (occNameFS (rdrNameOcc hole_occ)) > 1 -- Don't give this hint for plain "_"
= text "Or perhaps" <+> quotes (ppr hole_occ)
<+> text "is mis-spelled, or not in scope"
| otherwise
@@ -3425,8 +3425,8 @@ pprHoleError ctxt (Hole { hole_ty, hole_occ}) (HoleError sort other_tvs hole_sko
= ppWhenOption sdocPrintExplicitCoercions $
quotes (ppr tv) <+> text "is a coercion variable"
-pp_occ_with_type :: OccName -> Type -> SDoc
-pp_occ_with_type occ hole_ty = hang (pprPrefixOcc occ) 2 (dcolon <+> pprType hole_ty)
+pp_rdr_with_type :: RdrName -> Type -> SDoc
+pp_rdr_with_type occ hole_ty = hang (pprPrefixOcc occ) 2 (dcolon <+> pprType hole_ty)
{- *********************************************************************
* *
=====================================
compiler/GHC/Tc/Types/Constraint.hs
=====================================
@@ -124,6 +124,7 @@ import GHC.Data.Bag
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Constants (debugIsOn)
+import GHC.Types.Name.Reader
import Data.Coerce
import Data.Monoid ( Endo(..) )
@@ -307,7 +308,7 @@ instance Outputable DelayedError where
-- signatures). See Note [Holes].
data Hole
= Hole { hole_sort :: HoleSort -- ^ What flavour of hole is this?
- , hole_occ :: OccName -- ^ The name of this hole
+ , hole_occ :: RdrName -- ^ The name of this hole
, hole_ty :: TcType -- ^ Type to be printed to the user
-- For expression holes: type of expr
-- For type holes: the missing type
@@ -1233,7 +1234,7 @@ insolubleCt ct
-- | Does this hole represent an "out of scope" error?
-- See Note [Insoluble holes]
isOutOfScopeHole :: Hole -> Bool
-isOutOfScopeHole (Hole { hole_occ = occ }) = not (startsWithUnderscore occ)
+isOutOfScopeHole (Hole { hole_occ = occ }) = not (startsWithUnderscore (occName occ))
instance Outputable WantedConstraints where
ppr (WC {wc_simple = s, wc_impl = i, wc_errors = e})
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -580,7 +580,7 @@ data CtOrigin
PredType CtOrigin RealSrcSpan -- This constraint arising from ...
PredType CtOrigin RealSrcSpan -- and this constraint arising from ...
- | ExprHoleOrigin (Maybe OccName) -- from an expression hole
+ | ExprHoleOrigin (Maybe RdrName) -- from an expression hole
| TypeHoleOrigin OccName -- from a type hole (partial type signature)
| PatCheckOrigin -- normalisation of a type during pattern-match checking
| ListOrigin -- An overloaded list
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -1916,7 +1916,7 @@ emitAnonTypeHole :: IsExtraConstraint
emitAnonTypeHole extra_constraints tv
= do { ct_loc <- getCtLocM (TypeHoleOrigin occ) Nothing
; let hole = Hole { hole_sort = sort
- , hole_occ = occ
+ , hole_occ = mkRdrUnqual occ
, hole_ty = mkTyVarTy tv
, hole_loc = ct_loc }
; emitHole hole }
@@ -1930,7 +1930,7 @@ emitNamedTypeHole (name, tv)
= do { ct_loc <- setSrcSpan (nameSrcSpan name) $
getCtLocM (TypeHoleOrigin occ) Nothing
; let hole = Hole { hole_sort = TypeHole
- , hole_occ = occ
+ , hole_occ = nameRdrName name
, hole_ty = mkTyVarTy tv
, hole_loc = ct_loc }
; emitHole hole }
=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -153,6 +153,7 @@ import GHC.Utils.Constants (debugIsOn)
import Control.Monad
import GHC.Data.Maybe
import qualified Data.Semigroup as Semi
+import GHC.Types.Name.Reader
{-
************************************************************************
@@ -300,7 +301,7 @@ emitWantedEvVars :: CtOrigin -> [TcPredType] -> TcM [EvVar]
emitWantedEvVars orig = mapM (emitWantedEvVar orig)
-- | Emit a new wanted expression hole
-emitNewExprHole :: OccName -- of the hole
+emitNewExprHole :: RdrName -- of the hole
-> Type -> TcM HoleExprRef
emitNewExprHole occ ty
= do { u <- newUnique
=====================================
compiler/Language/Haskell/Syntax/Expr.hs
=====================================
@@ -30,7 +30,6 @@ import Language.Haskell.Syntax.Type
import Language.Haskell.Syntax.Binds
-- others:
-import GHC.Types.Name (OccName)
import GHC.Types.Fixity (LexicalFixity(Infix), Fixity)
import GHC.Types.SourceText (StringLiteral)
@@ -44,6 +43,7 @@ import Data.Either
import Data.Eq
import Data.Maybe
import Data.List.NonEmpty ( NonEmpty )
+import GHC.Types.Name.Reader
{- Note [RecordDotSyntax field updates]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -255,7 +255,7 @@ data HsExpr p
-- See Note [Located RdrNames]
| HsUnboundVar (XUnboundVar p)
- OccName -- ^ Unbound variable; also used for "holes"
+ RdrName -- ^ Unbound variable; also used for "holes"
-- (_ or _x).
-- Turned from HsVar to HsUnboundVar by the
-- renamer, when it finds an out-of-scope
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -193,8 +193,12 @@ splitSectionsIf pkgPredicate = addArgs $ do
pkg <- getPackage
osx <- expr isOsxTarget
not osx ? -- osx doesn't support split sections
- pkgPredicate pkg ? -- Only apply to these packages
- builder (Ghc CompileHs) ? arg "-split-sections"
+ pkgPredicate pkg ? mconcat -- Only apply to these packages
+ [ builder (Ghc CompileHs) ? arg "-split-sections"
+ , builder MergeObjects ? ifM (expr isWinTarget)
+ (pure ["-t", "driver/utils/merge_sections_pe.ld"])
+ (pure ["-t", "driver/utils/merge_sections.ld"])
+ ]
-- | Like 'splitSectionsIf', but with a fixed predicate: use
-- split sections for all packages but the GHC library.
=====================================
libraries/ghc-prim/GHC/Classes.hs
=====================================
@@ -410,19 +410,7 @@ instance Ord Char where
(C# c1) <= (C# c2) = isTrue# (c1 `leChar#` c2)
(C# c1) < (C# c2) = isTrue# (c1 `ltChar#` c2)
--- | Note that due to the presence of @NaN@, `Float`'s 'Ord' instance does not
--- satisfy reflexivity.
---
--- >>> 0/0 <= (0/0 :: Float)
--- False
---
--- Also note that, due to the same, `Ord`'s operator interactions are not
--- respected by `Float`'s instance:
---
--- >>> (0/0 :: Float) > 1
--- False
--- >>> compare (0/0 :: Float) 1
--- GT
+-- | See @instance@ 'Ord' 'Double' for discussion of deviations from IEEE 754 standard.
instance Ord Float where
(F# x) `compare` (F# y)
= if isTrue# (x `ltFloat#` y) then LT
@@ -434,19 +422,38 @@ instance Ord Float where
(F# x) >= (F# y) = isTrue# (x `geFloat#` y)
(F# x) > (F# y) = isTrue# (x `gtFloat#` y)
--- | Note that due to the presence of @NaN@, `Double`'s 'Ord' instance does not
--- satisfy reflexivity.
+-- | IEEE 754 'Double'-precision type includes not only numbers, but also
+-- positive and negative infinities and a special element called @NaN@
+-- (which can be quiet or signal).
--
--- >>> 0/0 <= (0/0 :: Double)
--- False
+-- IEEE 754-2008, section 5.11 requires that if at least one of arguments of
+-- '<=', '<', '>', '>=' is @NaN@ then the result of the comparison is 'False',
+-- and @instance@ 'Ord' 'Double' complies with this requirement. This violates
+-- the reflexivity: both @NaN@ '<=' @NaN@ and @NaN@ '>=' @NaN@ are 'False'.
--
--- Also note that, due to the same, `Ord`'s operator interactions are not
--- respected by `Double`'s instance:
+-- IEEE 754-2008, section 5.10 defines @totalOrder@ predicate. Unfortunately,
+-- 'compare' on 'Double's violates the IEEE standard and does not define a total order.
+-- More specifically, both 'compare' @NaN@ @x@ and 'compare' @x@ @NaN@ always return 'GT'.
+--
+-- Thus, users must be extremely cautious when using @instance@ 'Ord' 'Double'.
+-- For instance, one should avoid ordered containers with keys represented by 'Double',
+-- because data loss and corruption may happen. An IEEE-compliant 'compare' is available
+-- in @fp-ieee@ package as @TotallyOrdered@ newtype.
+--
+-- Moving further, the behaviour of 'min' and 'max' with regards to @NaN@ is
+-- also non-compliant. IEEE 754-2008, section 5.3.1 defines that quiet @NaN@
+-- should be treated as a missing data by @minNum@ and @maxNum@ functions,
+-- for example, @minNum(NaN, 1) = minNum(1, NaN) = 1 at . Some languages such as Java
+-- deviate from the standard implementing @minNum(NaN, 1) = minNum(1, NaN) = NaN at .
+-- However, 'min' / 'max' in @base@ are even worse: 'min' @NaN@ 1 is 1, but 'min' 1 @NaN@
+-- is @NaN at .
+--
+-- IEEE 754-2008 compliant 'min' / 'max' can be found in @ieee754@ package under
+-- @minNum@ / @maxNum@ names. Implementations compliant with
+-- @minimumNumber@ / @maximumNumber@ from a newer
+-- [IEEE 754-2019](https://grouper.ieee.org/groups/msc/ANSI_IEEE-Std-754-2019/background/),
+-- section 9.6 are available from @fp-ieee@ package.
--
--- >>> (0/0 :: Double) > 1
--- False
--- >>> compare (0/0 :: Double) 1
--- GT
instance Ord Double where
(D# x) `compare` (D# y)
= if isTrue# (x <## y) then LT
=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -1807,6 +1807,10 @@ mkNameU s u = Name (mkOccName s) (NameU u)
mkNameL :: String -> Uniq -> Name
mkNameL s u = Name (mkOccName s) (NameL u)
+-- | Only used internally
+mkNameQ :: String -> String -> Name
+mkNameQ mn occ = Name (mkOccName occ) (NameQ (mkModName mn))
+
-- | Used for 'x etc, but not available to the programmer
mkNameG :: NameSpace -> String -> String -> String -> Name
mkNameG ns pkg modu occ
=====================================
m4/fp_settings.m4
=====================================
@@ -10,12 +10,12 @@ AC_DEFUN([FP_SETTINGS],
# See Note [tooldir: How GHC finds mingw on Windows]
mingw_bin_prefix='$$tooldir/mingw/bin/'
SettingsCCompilerCommand="${mingw_bin_prefix}clang.exe"
- SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2"
+ SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2 -I$$tooldir/mingw/include"
SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe"
- SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2"
- SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2"
+ SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I$$tooldir/mingw/include"
+ SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L$$tooldir/mingw/lib -L$$tooldir/mingw/x86_64-w64-mingw32/lib"
SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe"
- SettingsHaskellCPPFlags="$HaskellCPPArgs"
+ SettingsHaskellCPPFlags="$HaskellCPPArgs -I$$tooldir/mingw/include"
SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe"
SettingsLdFlags=""
# LLD does not support object merging (#21068)
=====================================
testsuite/tests/perf/compiler/hard_hole_fits.stderr
=====================================
@@ -22,7 +22,7 @@ hard_hole_fits.hs:15:32: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: Int
• In an equation for ‘testMe’: testMe (HsUnboundVar xuv uv) = _
• Relevant bindings include
- uv :: GHC.Types.Name.Occurrence.OccName
+ uv :: GHC.Types.Name.Reader.RdrName
(bound at hard_hole_fits.hs:15:26)
xuv :: Language.Haskell.Syntax.Extension.XUnboundVar GhcPs
(bound at hard_hole_fits.hs:15:22)
=====================================
testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs
=====================================
@@ -34,7 +34,7 @@ fromModule _ = []
toHoleFitCommand :: TypedHole -> String -> Maybe String
toHoleFitCommand (TypedHole {th_hole = Just (Hole { hole_occ = h })}) str
- = stripPrefix ("_" <> str) $ occNameString h
+ = stripPrefix ("_" <> str) $ occNameString (occName h)
toHoleFitCommand _ _ = Nothing
=====================================
testsuite/tests/quotes/T20472_quotes.hs
=====================================
@@ -0,0 +1,6 @@
+{-# 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.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/960f43ec85b0faca4e0a3c88286d585fbfe77ec4...dcdc3b992c267b046716a1d1a06610c80642a8f7
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/960f43ec85b0faca4e0a3c88286d585fbfe77ec4...dcdc3b992c267b046716a1d1a06610c80642a8f7
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/20221224/dffcbd52/attachment-0001.html>
More information about the ghc-commits
mailing list