[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: nativeGen: Explicitly set flags of text sections on Windows

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Fri Jul 21 12:02:45 UTC 2023



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00
nativeGen: Explicitly set flags of text sections on Windows

The binutils documentation (for COFF) claims,

> If no flags are specified, the default flags depend upon the section
> name. If the section name is not recognized, the default will be for the
> section to be loaded and writable.

We previously assumed that this would do the right thing for split
sections (e.g. a section named `.text$foo` would be correctly inferred
to be a text section). However, we have observed that this is not the
case (at least under the clang toolchain used on Windows): when
split-sections is enabled, text sections are treated by the assembler as
data (matching the "default" behavior specified by the documentation).

Avoid this by setting section flags explicitly. This should fix split
sections on Windows.

Fixes #22834.

- - - - -
db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00
nativeGen: Set explicit section types on all platforms

- - - - -
b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00
Insert documentation into parsed signature modules

Causes haddock comments in signature modules to be properly
inserted into the AST (just as they are for regular modules)
if the `-haddock` flag is given.

Also adds a test that compares `-ddump-parsed-ast` output
for a signature module to prevent further regressions.

Fixes #23315

- - - - -
70f3b87c by Matthew Pickering at 2023-07-21T08:02:30-04:00
Allow users to override non-essential haddock options in a Flavour

We now supply the non-essential options to haddock using the `extraArgs`
field, which can be specified in a Flavour so that if an advanced user
wants to change how documentation is generated then they can use
something other than the `defaultHaddockExtraArgs`.

This does have the potential to regress some packaging if a user has
overridden `extraArgs` themselves, because now they also need to add
the haddock options to extraArgs. This can easily be done by appending
`defaultHaddockExtraArgs` to their extraArgs invocation but someone
might not notice this behaviour has changed.

In any case, I think passing the non-essential options in this manner is
the right thing to do and matches what we do for the "ghc" builder,
which by default doesn't pass any optmisation levels, and would likewise
be very bad if someone didn't pass suitable `-O` levels for builds.

Fixes #23625

- - - - -
1321f1e9 by Matthew Pickering at 2023-07-21T08:02:31-04:00
simplifier: Correct InScopeSet in rule matching

The in-scope set passedto the `exprIsLambda_maybe` call lacked all the
in-scope binders. @simonpj suggests this fix where we augment the
in-scope set with the free variables of expression which fixes this
failure mode in quite a direct way.

Fixes #23630

- - - - -
335926aa by Krzysztof Gogolewski at 2023-07-21T08:02:31-04:00
Add a test for #23413

It was fixed by commit e1590ddc661d6: Add the SolverStage monad.

- - - - -
46c04c0c by Matthew Pickering at 2023-07-21T08:02:32-04:00
ci: Enable some more jobs to run in a marge batch

In !10907 I made the majority of jobs not run on a validate pipeline but
then forgot to renable a select few jobs on the marge batch MR.

- - - - -


23 changed files:

- .gitlab-ci.yml
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/CmmToAsm/Ppr.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Parser.y
- hadrian/src/Settings/Builders/Haddock.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Default.hs-boot
- hadrian/src/Settings/Flavours/Benchmark.hs
- hadrian/src/Settings/Flavours/Development.hs
- hadrian/src/Settings/Flavours/Performance.hs
- hadrian/src/Settings/Flavours/Validate.hs
- + testsuite/tests/parser/should_compile/T23315/Makefile
- + testsuite/tests/parser/should_compile/T23315/Setup.hs
- + testsuite/tests/parser/should_compile/T23315/T23315.cabal
- + testsuite/tests/parser/should_compile/T23315/T23315.hsig
- + testsuite/tests/parser/should_compile/T23315/T23315.stderr
- + testsuite/tests/parser/should_compile/T23315/all.T
- + testsuite/tests/simplCore/should_compile/T23630.hs
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/typecheck/should_compile/T23413.hs
- testsuite/tests/typecheck/should_compile/all.T


Changes:

=====================================
.gitlab-ci.yml
=====================================
@@ -433,6 +433,7 @@ hadrian-multi:
       - cabal-cache
   rules:
     - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/'
+    - if: '$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/'
 
 ############################################################
 # stack-hadrian-build
@@ -511,7 +512,7 @@ doc-tarball:
       optional: true
     - job: nightly-x86_64-windows-validate
       optional: true
-    - job: release-x86_64-windows-release+no_split_sections
+    - job: release-x86_64-windows-release
       optional: true
 
   tags:
@@ -535,7 +536,7 @@ doc-tarball:
         || mv "ghc-x86_64-linux-deb10-release.tar.xz" "$LINUX_BINDIST" \
         || true
       mv "ghc-x86_64-windows-validate.tar.xz" "$WINDOWS_BINDIST" \
-        || mv "ghc-x86_64-windows-release+no_split_sections.tar.xz" "$WINDOWS_BINDIST" \
+        || mv "ghc-x86_64-windows-release.tar.xz" "$WINDOWS_BINDIST" \
         || true
       if [ ! -f "$LINUX_BINDIST" ]; then
         echo "Error: $LINUX_BINDIST does not exist. Did the Debian 9 job fail?"
@@ -831,6 +832,7 @@ perf-nofib:
     - if: '$CI_COMMIT_BRANCH == "master"'
     - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/'
     - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/'
+    - if: '$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/'
   tags:
     - x86_64-linux
   before_script:
@@ -898,6 +900,7 @@ perf:
       - out
   rules:
     - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/'
+    - if: '$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/'
 
 ############################################################
 # ABI testing
@@ -938,6 +941,7 @@ abi-test:
       - out
   rules:
     - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/'
+    - if: '$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/'
 
 
 ############################################################


=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -921,8 +921,8 @@ job_groups =
      -- This job is only for generating head.hackage docs
      , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig))
      , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf)
-     , fastCI (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken vanilla))
-     , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt))
+     , fastCI (standardBuildsWithConfig Amd64 Windows vanilla)
+     , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt)
      , standardBuilds Amd64 Darwin
      , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla))
      , fastCI (standardBuilds AArch64 Darwin)


=====================================
.gitlab/jobs.yaml
=====================================
@@ -3577,7 +3577,7 @@
       "XZ_OPT": "-9"
     }
   },
-  "release-x86_64-windows-int_native-release+no_split_sections": {
+  "release-x86_64-windows-int_native-release": {
     "after_script": [
       "bash .gitlab/ci.sh save_cache",
       "bash .gitlab/ci.sh save_test_output",
@@ -3587,7 +3587,7 @@
     "artifacts": {
       "expire_in": "1 year",
       "paths": [
-        "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz",
+        "ghc-x86_64-windows-int_native-release.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -3626,8 +3626,8 @@
     ],
     "variables": {
       "BIGNUM_BACKEND": "native",
-      "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release+no_split_sections",
-      "BUILD_FLAVOUR": "release+no_split_sections",
+      "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release",
+      "BUILD_FLAVOUR": "release",
       "CABAL_INSTALL_VERSION": "3.8.1.0",
       "CONFIGURE_ARGS": "",
       "GHC_VERSION": "9.4.3",
@@ -3636,11 +3636,11 @@
       "LANG": "en_US.UTF-8",
       "MSYSTEM": "CLANG64",
       "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections",
+      "TEST_ENV": "x86_64-windows-int_native-release",
       "XZ_OPT": "-9"
     }
   },
-  "release-x86_64-windows-release+no_split_sections": {
+  "release-x86_64-windows-release": {
     "after_script": [
       "bash .gitlab/ci.sh save_cache",
       "bash .gitlab/ci.sh save_test_output",
@@ -3650,7 +3650,7 @@
     "artifacts": {
       "expire_in": "1 year",
       "paths": [
-        "ghc-x86_64-windows-release+no_split_sections.tar.xz",
+        "ghc-x86_64-windows-release.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -3689,8 +3689,8 @@
     ],
     "variables": {
       "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-windows-release+no_split_sections",
-      "BUILD_FLAVOUR": "release+no_split_sections",
+      "BIN_DIST_NAME": "ghc-x86_64-windows-release",
+      "BUILD_FLAVOUR": "release",
       "CABAL_INSTALL_VERSION": "3.8.1.0",
       "CONFIGURE_ARGS": "",
       "GHC_VERSION": "9.4.3",
@@ -3699,7 +3699,7 @@
       "LANG": "en_US.UTF-8",
       "MSYSTEM": "CLANG64",
       "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-windows-release+no_split_sections",
+      "TEST_ENV": "x86_64-windows-release",
       "XZ_OPT": "-9"
     }
   },


=====================================
compiler/GHC/CmmToAsm/Ppr.hs
=====================================
@@ -245,6 +245,10 @@ pprGNUSectionHeader config t suffix =
       OtherSection _ ->
         panic "PprBase.pprGNUSectionHeader: unknown section type"
     flags = case t of
+      Text
+        | OSMinGW32 <- platformOS platform
+                    -> text ",\"xr\""
+        | otherwise -> text ",\"ax\"," <> sectionType platform "progbits"
       CString
         | OSMinGW32 <- platformOS platform
                     -> empty


=====================================
compiler/GHC/Core/Rules.hs
=====================================
@@ -888,9 +888,6 @@ So we must add the template vars to the in-scope set before starting;
 see `init_menv` in `matchN`.
 -}
 
-rvInScopeEnv :: RuleMatchEnv -> InScopeEnv
-rvInScopeEnv renv = ISE (rnInScopeSet (rv_lcl renv)) (rv_unf renv)
-
 -- * The domain of the TvSubstEnv and IdSubstEnv are the template
 --   variables passed into the match.
 --
@@ -1271,7 +1268,16 @@ match renv subst e1 (Let bind e2) mco
 
 ------------------------  Lambdas ---------------------
 match renv subst (Lam x1 e1) e2 mco
-  | Just (x2, e2', ts) <- exprIsLambda_maybe (rvInScopeEnv renv) (mkCastMCo e2 mco)
+  | let casted_e2 = mkCastMCo e2 mco
+        in_scope = extendInScopeSetSet (rnInScopeSet (rv_lcl renv))
+                                       (exprFreeVars casted_e2)
+        in_scope_env = ISE in_scope (rv_unf renv)
+        -- extendInScopeSetSet: The InScopeSet of rn_env is not necessarily
+        -- a superset of the free vars of e2; it is only guaranteed a superset of
+        -- applyng the (rnEnvR rn_env) substitution to e2. But exprIsLambda_maybe
+        -- wants an in-scope set that includes all the free vars of its argument.
+        -- Hence adding adding (exprFreeVars casted_e2) to the in-scope set (#23630)
+  , Just (x2, e2', ts) <- exprIsLambda_maybe in_scope_env casted_e2
     -- See Note [Lambdas in the template]
   = let renv'  = rnMatchBndr2 renv x1 x2
         subst' = subst { rs_binds = rs_binds subst . flip (foldr mkTick) ts }


=====================================
compiler/GHC/Parser.y
=====================================
@@ -751,7 +751,7 @@ TH_QQUASIQUOTE  { L _ (ITqQuasiQuote _) }
 
 -- Exported parsers
 %name parseModuleNoHaddock module
-%name parseSignature signature
+%name parseSignatureNoHaddock signature
 %name parseImport importdecl
 %name parseStatement e_stmt
 %name parseDeclaration topdecl
@@ -4416,18 +4416,29 @@ pvL :: MonadP m => m (LocatedAn t a) -> m (Located a)
 pvL a = do { av <- a
            ; return (reLoc av) }
 
--- | Parse a Haskell module with Haddock comments.
--- This is done in two steps:
+-- | Parse a Haskell module with Haddock comments. This is done in two steps:
 --
 -- * 'parseModuleNoHaddock' to build the AST
 -- * 'addHaddockToModule' to insert Haddock comments into it
 --
--- This is the only parser entry point that deals with Haddock comments.
--- The other entry points ('parseDeclaration', 'parseExpression', etc) do
--- not insert them into the AST.
+-- This and the signature module parser are the only parser entry points that
+-- deal with Haddock comments. The other entry points ('parseDeclaration',
+-- 'parseExpression', etc) do not insert them into the AST.
 parseModule :: P (Located (HsModule GhcPs))
 parseModule = parseModuleNoHaddock >>= addHaddockToModule
 
+-- | Parse a Haskell signature module with Haddock comments. This is done in two
+-- steps:
+--
+-- * 'parseSignatureNoHaddock' to build the AST
+-- * 'addHaddockToModule' to insert Haddock comments into it
+--
+-- This and the module parser are the only parser entry points that deal with
+-- Haddock comments. The other entry points ('parseDeclaration',
+-- 'parseExpression', etc) do not insert them into the AST.
+parseSignature :: P (Located (HsModule GhcPs))
+parseSignature = parseSignatureNoHaddock >>= addHaddockToModule
+
 commentsA :: (Monoid ann) => SrcSpan -> EpAnnComments -> SrcSpanAnn' (EpAnn ann)
 commentsA loc cs = SrcSpanAnn (EpAnn (Anchor (rs loc) UnchangedAnchor) mempty cs) loc
 


=====================================
hadrian/src/Settings/Builders/Haddock.hs
=====================================
@@ -50,6 +50,10 @@ haddockBuilderArgs = mconcat
         baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs)
         let baseUrl p = substituteTemplate baseUrlTemplate p
         ghcOpts  <- haddockGhcArgs
+        -- These are the options which are necessary to perform the build. Additional
+        -- options such as `--hyperlinked-source`, `--hoogle`, `--quickjump` are
+        -- added by the `extraArgs` field in the flavour. The defaults are provided
+        -- by `defaultHaddockExtraArgs`.
         mconcat
             [ arg "--verbosity=0"
             , arg $ "-B" ++ root -/- stageString Stage1 -/- "lib"
@@ -57,9 +61,6 @@ haddockBuilderArgs = mconcat
             , arg $ "--odir=" ++ takeDirectory output
             , arg $ "--dump-interface=" ++ output
             , arg "--html"
-            , arg "--hyperlinked-source"
-            , arg "--hoogle"
-            , arg "--quickjump"
             , arg $ "--title=" ++ pkgName pkg ++ "-" ++ version
                     ++ ": " ++ synopsis
             , arg $ "--prologue=" ++ takeDirectory output -/- "haddock-prologue.txt"


=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -7,7 +7,7 @@ module Settings.Default (
 
     -- * Default command line arguments for various builders
     SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs,
-    defaultExtraArgs,
+    defaultExtraArgs, defaultHaddockExtraArgs,
 
     -- * Default build flavour and BigNum backend
     defaultFlavour, defaultBignumBackend
@@ -219,7 +219,13 @@ sourceArgs SourceArgs {..} = builder Ghc ? mconcat
 
 -- | All default command line arguments.
 defaultExtraArgs :: Args
-defaultExtraArgs = sourceArgs defaultSourceArgs
+defaultExtraArgs =
+  mconcat [ sourceArgs defaultSourceArgs, defaultHaddockExtraArgs ]
+
+defaultHaddockExtraArgs :: Args
+defaultHaddockExtraArgs = builder (Haddock BuildPackage) ?
+  mconcat [ arg "--hyperlinked-source", arg "--hoogle", arg "--quickjump" ]
+
 
 -- | Default source arguments, e.g. optimisation settings.
 defaultSourceArgs :: SourceArgs


=====================================
hadrian/src/Settings/Default.hs-boot
=====================================
@@ -1,6 +1,6 @@
 module Settings.Default (
     SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs,
-    defaultExtraArgs, defaultLibraryWays, defaultRtsWays,
+    defaultExtraArgs, defaultHaddockExtraArgs, defaultLibraryWays, defaultRtsWays,
     defaultFlavour, defaultBignumBackend
     ) where
 
@@ -15,7 +15,7 @@ data SourceArgs = SourceArgs
 
 sourceArgs :: SourceArgs -> Args
 
-defaultBuilderArgs, defaultPackageArgs, defaultExtraArgs :: Args
+defaultBuilderArgs, defaultPackageArgs, defaultExtraArgs, defaultHaddockExtraArgs :: Args
 defaultLibraryWays, defaultRtsWays :: Ways
 defaultFlavour :: Flavour
 defaultBignumBackend :: String


=====================================
hadrian/src/Settings/Flavours/Benchmark.hs
=====================================
@@ -10,7 +10,7 @@ import {-# SOURCE #-} Settings.Default
 benchmarkFlavour :: Flavour
 benchmarkFlavour = defaultFlavour
     { name = "bench"
-    , extraArgs = benchmarkArgs
+    , extraArgs = benchmarkArgs <> defaultHaddockExtraArgs
     , libraryWays = pure $ Set.fromList [vanilla]
     , rtsWays = Set.fromList <$> mconcat [pure [vanilla], targetSupportsThreadedRts ? pure [threaded]] }
 


=====================================
hadrian/src/Settings/Flavours/Development.hs
=====================================
@@ -12,7 +12,7 @@ import {-# SOURCE #-} Settings.Default
 developmentFlavour :: Stage -> Flavour
 developmentFlavour ghcStage = defaultFlavour
     { name = "devel" ++ stageString ghcStage
-    , extraArgs = developmentArgs ghcStage
+    , extraArgs = developmentArgs ghcStage <> defaultHaddockExtraArgs
     , libraryWays = pure $ Set.fromList [vanilla]
     , rtsWays = Set.fromList <$> mconcat [pure [vanilla, debug], targetSupportsThreadedRts ? pure [threaded, threadedDebug]]
     , dynamicGhcPrograms = return False


=====================================
hadrian/src/Settings/Flavours/Performance.hs
=====================================
@@ -8,7 +8,7 @@ import {-# SOURCE #-} Settings.Default
 performanceFlavour :: Flavour
 performanceFlavour = splitSections $ defaultFlavour
     { name = "perf"
-    , extraArgs = performanceArgs }
+    , extraArgs = performanceArgs <> defaultHaddockExtraArgs }
 
 performanceArgs :: Args
 performanceArgs = sourceArgs SourceArgs


=====================================
hadrian/src/Settings/Flavours/Validate.hs
=====================================
@@ -12,7 +12,7 @@ import {-# SOURCE #-} Settings.Default
 validateFlavour :: Flavour
 validateFlavour = enableLinting $ werror $ defaultFlavour
     { name = "validate"
-    , extraArgs = validateArgs
+    , extraArgs = validateArgs <> defaultHaddockExtraArgs
     , libraryWays = Set.fromList <$>
                     mconcat [ pure [vanilla]
                             , notStage0 ? platformSupportsSharedLibs ? pure [dynamic]


=====================================
testsuite/tests/parser/should_compile/T23315/Makefile
=====================================
@@ -0,0 +1,18 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+SETUP = ./Setup -v0
+
+T23315: clean
+	$(MAKE) clean
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup
+	$(SETUP) clean
+	$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)'
+	$(SETUP) build 1>&2
+ifneq "$(CLEANUP)" ""
+	$(MAKE) clean
+endif
+
+clean :
+	$(RM) -r */dist Setup$(exeext) *.o *.hi


=====================================
testsuite/tests/parser/should_compile/T23315/Setup.hs
=====================================
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
\ No newline at end of file


=====================================
testsuite/tests/parser/should_compile/T23315/T23315.cabal
=====================================
@@ -0,0 +1,10 @@
+name:                T23315
+version:             0.1.0.0
+build-type:          Simple
+cabal-version:       2.0
+
+library
+  signatures:          T23315
+  build-depends:       base >= 4.3 && < 5
+  default-language:    Haskell2010
+  ghc-options:         -Wall -haddock -ddump-parsed-ast


=====================================
testsuite/tests/parser/should_compile/T23315/T23315.hsig
=====================================
@@ -0,0 +1,4 @@
+signature T23315 where
+-- | My unit
+a :: ()
+-- ^ More docs


=====================================
testsuite/tests/parser/should_compile/T23315/T23315.stderr
=====================================
@@ -0,0 +1,112 @@
+
+==================== Parser AST ====================
+
+(L
+ { T23315.hsig:1:1 }
+ (HsModule
+  (XModulePs
+   (EpAnn
+    (Anchor
+     { T23315.hsig:1:1 }
+     (UnchangedAnchor))
+    (AnnsModule
+     [(AddEpAnn AnnSignature (EpaSpan { T23315.hsig:1:1-9 }))
+     ,(AddEpAnn AnnWhere (EpaSpan { T23315.hsig:1:18-22 }))]
+      []
+     (Nothing))
+    (EpaComments
+     []))
+   (VirtualBraces
+    (1))
+   (Nothing)
+   (Nothing))
+  (Just
+   (L
+    (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:1:11-16 })
+    {ModuleName: T23315}))
+  (Nothing)
+  []
+  [(L
+    (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:2:1-12 })
+    (DocD
+     (NoExtField)
+     (DocCommentNext
+      (L
+       { T23315.hsig:2:1-12 }
+       (WithHsDocIdentifiers
+        (MultiLineDocString
+         (HsDocStringNext)
+         (:|
+          (L
+           { T23315.hsig:2:5-12 }
+           (HsDocStringChunk
+            " My unit"))
+          []))
+        [])))))
+  ,(L
+    (SrcSpanAnn (EpAnn
+                 (Anchor
+                  { T23315.hsig:3:1-7 }
+                  (UnchangedAnchor))
+                 (AnnListItem
+                  [])
+                 (EpaComments
+                  [])) { T23315.hsig:3:1-7 })
+    (SigD
+     (NoExtField)
+     (TypeSig
+      (EpAnn
+       (Anchor
+        { T23315.hsig:3:1 }
+        (UnchangedAnchor))
+       (AnnSig
+        (AddEpAnn AnnDcolon (EpaSpan { T23315.hsig:3:3-4 }))
+        [])
+       (EpaComments
+        []))
+      [(L
+        (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:1 })
+        (Unqual
+         {OccName: a}))]
+      (HsWC
+       (NoExtField)
+       (L
+        (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 })
+        (HsSig
+         (NoExtField)
+         (HsOuterImplicit
+          (NoExtField))
+         (L
+          (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 })
+          (HsTupleTy
+           (EpAnn
+            (Anchor
+             { T23315.hsig:3:6 }
+             (UnchangedAnchor))
+            (AnnParen
+             (AnnParens)
+             (EpaSpan { T23315.hsig:3:6 })
+             (EpaSpan { T23315.hsig:3:7 }))
+            (EpaComments
+             []))
+           (HsBoxedOrConstraintTuple)
+           []))))))))
+  ,(L
+    (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:4:1-14 })
+    (DocD
+     (NoExtField)
+     (DocCommentPrev
+      (L
+       { T23315.hsig:4:1-14 }
+       (WithHsDocIdentifiers
+        (MultiLineDocString
+         (HsDocStringPrevious)
+         (:|
+          (L
+           { T23315.hsig:4:5-14 }
+           (HsDocStringChunk
+            " More docs"))
+          []))
+        [])))))]))
+
+


=====================================
testsuite/tests/parser/should_compile/T23315/all.T
=====================================
@@ -0,0 +1,3 @@
+test('T23315',
+     [extra_files(['Setup.hs']), js_broken(22352)],
+     makefile_test, [])


=====================================
testsuite/tests/simplCore/should_compile/T23630.hs
=====================================
@@ -0,0 +1,17 @@
+module T23630 where
+
+data HOLType = UTypeIn !HOLType deriving Eq
+
+tyVars :: HOLType -> [HOLType]
+tyVars (UTypeIn tv) = [undefined]
+
+union :: Eq a => [a] -> [a] -> [a]
+union l1 l2 = foldr insert l2 l1
+
+insert :: Eq a => a -> [a] -> [a]
+insert x l
+    | x `elem` l = l
+    | otherwise = x : l
+
+catTyVars :: [HOLType] -> [HOLType]
+catTyVars = foldr (union . tyVars) []


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -472,6 +472,7 @@ test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-agg
 test('T22802', normal, compile, ['-O'])
 test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques'])
 test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0'])
+test('T23630', normal, compile, ['-O'])
 test('T23012', normal, compile, ['-O'])
 
 test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques'])


=====================================
testsuite/tests/typecheck/should_compile/T23413.hs
=====================================
@@ -0,0 +1,13 @@
+module T23413 where
+
+f :: (Int ~ Bool) => Int -> Bool
+f x = f x
+
+g1 :: (Int ~ Bool) => Int -> Bool
+g1 x = f x
+
+g2 :: (Bool ~ Int) => Int -> Bool
+g2 x = f x
+
+h :: (Int ~ Bool) => Int -> Bool
+h x = x


=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -888,3 +888,4 @@ test('T23514c', normal, compile, [''])
 test('T22537', normal, compile, [''])
 test('T18986a', normal, compile, [''])
 test('T18986b', normal, compile, [''])
+test('T23413', normal, compile, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6757d9a7c66013d299ea8ad24548354435eda00...46c04c0c5d69d03651eaa4645b3b5a29a66aebf3

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6757d9a7c66013d299ea8ad24548354435eda00...46c04c0c5d69d03651eaa4645b3b5a29a66aebf3
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/20230721/97fe00ac/attachment-0001.html>


More information about the ghc-commits mailing list