[Git][ghc/ghc][wip/9.12.1-alpha1] 5 commits: haddock: oneshot tests can drop files if they share modtimes. Stop this by
Zubin (@wz1000)
gitlab at gitlab.haskell.org
Mon Oct 14 08:51:09 UTC 2024
Zubin pushed to branch wip/9.12.1-alpha1 at Glasgow Haskell Compiler / GHC
Commits:
e78c7ef9 by Zubin Duggal at 2024-10-14T14:20:59+05:30
haddock: oneshot tests can drop files if they share modtimes. Stop this by
including the filename in the key.
Ideally we would use `ghc -M` output to do a proper toposort
Partially addresses #25372
- - - - -
4feb361f by Zubin Duggal at 2024-10-14T14:20:59+05:30
testsuite: normalise some versions in callstacks
- - - - -
b872c09a by Zubin Duggal at 2024-10-14T14:20:59+05:30
testsuite: use -fhide-source-paths to normalise some backpack tests
- - - - -
9e6fa9e0 by Zubin Duggal at 2024-10-14T14:20:59+05:30
testsuite/haddock: strip version identifiers and unit hashes from html tests
- - - - -
380d89bb by Zubin Duggal at 2024-10-14T14:20:59+05:30
Prepare 9.12.1 alpha
- - - - -
13 changed files:
- configure.ac
- testsuite/tests/backpack/should_compile/all.T
- testsuite/tests/backpack/should_compile/bkp16.stderr
- testsuite/tests/backpack/should_fail/all.T
- testsuite/tests/backpack/should_fail/bkpfail17.stderr
- testsuite/tests/backpack/should_fail/bkpfail19.stderr
- testsuite/tests/ghc-e/should_fail/T9930fail.stderr
- testsuite/tests/ghc-e/should_fail/all.T
- utils/haddock/haddock-test/src/Test/Haddock.hs
- utils/haddock/haddock-test/src/Test/Haddock/Xhtml.hs
- utils/haddock/html-test/Main.hs
- utils/haddock/html-test/ref/Bug1004.html
- utils/haddock/html-test/ref/Bug548.html
Changes:
=====================================
configure.ac
=====================================
@@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.12], [glasgow-hask
AC_CONFIG_MACRO_DIRS([m4])
# Set this to YES for a released version, otherwise NO
-: ${RELEASE=YES}
+: ${RELEASE=NO}
# The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line
# above. If this is not a released version, then we will append the
=====================================
testsuite/tests/backpack/should_compile/all.T
=====================================
@@ -8,7 +8,7 @@ test('bkp11', normal, backpack_compile, [''])
test('bkp12', normal, backpack_compile, [''])
test('bkp14', normal, backpack_compile, [''])
test('bkp15', normal, backpack_compile, [''])
-test('bkp16', normalise_version('base', 'ghc-internal'), backpack_compile, [''])
+test('bkp16', [normalise_version('base', 'ghc-internal')], backpack_compile, ['-fhide-source-paths'])
test('bkp17', normal, backpack_compile, [''])
test('bkp18', normal, backpack_compile, [''])
test('bkp19', normal, backpack_compile, [''])
@@ -60,4 +60,4 @@ test('T13214', normal, backpack_compile, [''])
test('T13250', normal, backpack_compile, [''])
test('T13323', normal, backpack_compile, [''])
test('T20396', normal, backpack_compile, [''])
-test('T23424', [ignore_stdout, ignore_stderr], backpack_compile, ['-ddump-rn-trace -ddump-if-trace -ddump-tc-trace'])
\ No newline at end of file
+test('T23424', [ignore_stdout, ignore_stderr], backpack_compile, ['-ddump-rn-trace -ddump-if-trace -ddump-tc-trace'])
=====================================
testsuite/tests/backpack/should_compile/bkp16.stderr
=====================================
@@ -1,9 +1,9 @@
[1 of 2] Processing p
- [1 of 1] Compiling Int[sig] ( p/Int.hsig, nothing )
+ [1 of 1] Compiling Int[sig]
[2 of 2] Processing q
Instantiating q
[1 of 1] Including p[Int=base-4.20.0.0:GHC.Exts]
Instantiating p[Int=base-4.20.0.0:GHC.Exts]
[1 of 1] Including base-4.20.0.0
- [1 of 1] Compiling Int[sig] ( p/Int.hsig, bkp16.out/p/p-3JmGAx0a1DyKjX6bh7CxGJ/Int.o )
+ [1 of 1] Compiling Int[sig]
[1 of 1] Instantiating p
=====================================
testsuite/tests/backpack/should_fail/all.T
=====================================
@@ -12,9 +12,9 @@ test('bkpfail13', normal, backpack_compile_fail, [''])
test('bkpfail14', normal, backpack_compile_fail, [''])
test('bkpfail15', normal, backpack_compile_fail, [''])
test('bkpfail16', normalise_version('ghc-internal', 'base'), backpack_compile_fail, [''])
-test('bkpfail17', normalise_version('ghc-internal', 'base'), backpack_compile_fail, [''])
+test('bkpfail17', normalise_version('ghc-internal', 'base'), backpack_compile_fail, ['-fhide-source-paths'])
test('bkpfail18', normal, backpack_compile_fail, [''])
-test('bkpfail19', normalise_version('ghc-internal', 'base'), backpack_compile_fail, [''])
+test('bkpfail19', normalise_version('ghc-internal', 'base'), backpack_compile_fail, ['-fhide-source-paths'])
test('bkpfail20', normal, backpack_compile_fail, [''])
test('bkpfail21', normal, backpack_compile_fail, [''])
test('bkpfail22', normal, backpack_compile_fail, [''])
=====================================
testsuite/tests/backpack/should_fail/bkpfail17.stderr
=====================================
@@ -1,10 +1,10 @@
[1 of 2] Processing p
- [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, nothing )
+ [1 of 1] Compiling ShouldFail[sig]
[2 of 2] Processing q
Instantiating q
[1 of 1] Including p[ShouldFail=base-4.20.0.0:Prelude]
Instantiating p[ShouldFail=base-4.20.0.0:Prelude]
- [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, bkpfail17.out/p/p-9R9TTjIBG3MEjwCQffKVYM/ShouldFail.o )
+ [1 of 1] Compiling ShouldFail[sig]
<no location info>: error: [GHC-15843]
• Type constructor ‘Either’ has conflicting definitions in the module
and its hsig file.
=====================================
testsuite/tests/backpack/should_fail/bkpfail19.stderr
=====================================
@@ -1,10 +1,10 @@
[1 of 2] Processing p
- [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, nothing )
+ [1 of 1] Compiling ShouldFail[sig]
[2 of 2] Processing q
Instantiating q
[1 of 1] Including p[ShouldFail=base-4.20.0.0:Data.STRef]
Instantiating p[ShouldFail=base-4.20.0.0:Data.STRef]
- [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, bkpfail19.out/p/p-Gwl8Z2CPH0M7Zi2wPSYSbs/ShouldFail.o )
+ [1 of 1] Compiling ShouldFail[sig]
<no location info>: error: [GHC-12424]
• The hsig file (re)exports ‘Data.STRef.Lazy.newSTRef’
but the implementing module exports a different identifier ‘GHC.Internal.STRef.newSTRef’
=====================================
testsuite/tests/ghc-e/should_fail/T9930fail.stderr
=====================================
@@ -3,46 +3,46 @@ ghc: Exception:
default output name would overwrite the input file; must specify -o explicitly
Usage: For basic information, try the `--help' option.
-Package: ghc-9.11-inplace
+Package: ghc-9.12-8fe2
Module: GHC.Utils.Panic
Type: GhcException
While handling default output name would overwrite the input file; must specify -o explicitly
| Usage: For basic information, try the `--help' option.
|
- | Package: ghc-9.11-inplace
+ | Package: ghc-9.12-8fe2
| Module: GHC.Utils.Panic
| Type: GhcException
|
| While handling default output name would overwrite the input file; must specify -o explicitly
| | Usage: For basic information, try the `--help' option.
| |
- | | Package: ghc-9.11-inplace
+ | | Package: ghc-9.12-8fe2
| | Module: GHC.Utils.Panic
| | Type: GhcException
| |
| | While handling default output name would overwrite the input file; must specify -o explicitly
| | | Usage: For basic information, try the `--help' option.
| | |
- | | | Package: ghc-9.11-inplace
+ | | | Package: ghc-9.12-8fe2
| | | Module: GHC.Utils.Panic
| | | Type: GhcException
| | |
| | | HasCallStack backtrace:
- | | | collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
- | | | toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
- | | | throw, called at compiler/GHC/Utils/Panic.hs:180:21 in ghc-9.11-inplace:GHC.Utils.Panic
+ | | | collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
+ | | | toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
+ | | | throw, called at compiler/GHC/Utils/Panic.hs:180:21 in ghc-9.12-8fe2:GHC.Utils.Panic
| |
| | HasCallStack backtrace:
- | | bracket_, called at libraries/semaphore-compat/src/System/Semaphore.hs:320:23 in semaphore-compat-1.0.0-inplace:System.Semaphore
+ | | bracket_, called at libraries/semaphore-compat/src/System/Semaphore.hs:320:23 in semaphore-compat-1.0.0-c856:System.Semaphore
|
| HasCallStack backtrace:
- | collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
+ | collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
| toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:284:11 in ghc-internal:GHC.Internal.IO
- | throwIO, called at libraries/exceptions/src/Control/Monad/Catch.hs:371:12 in exceptions-0.10.7-inplace:Control.Monad.Catch
- | throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:860:84 in exceptions-0.10.7-inplace:Control.Monad.Catch
- | onException, called at compiler/GHC/Driver/Make.hs:2986:23 in ghc-9.11-inplace:GHC.Driver.Make
+ | throwIO, called at libraries/exceptions/src/Control/Monad/Catch.hs:371:12 in exceptions-0.10.7-71b0:Control.Monad.Catch
+ | throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:860:84 in exceptions-0.10.7-71b0:Control.Monad.Catch
+ | onException, called at compiler/GHC/Driver/Make.hs:2988:23 in ghc-9.12-8fe2:GHC.Driver.Make
HasCallStack backtrace:
- bracket, called at compiler/GHC/Driver/Make.hs:2953:3 in ghc-9.11-inplace:GHC.Driver.Make
+ bracket, called at compiler/GHC/Driver/Make.hs:2955:3 in ghc-9.12-8fe2:GHC.Driver.Make
=====================================
testsuite/tests/ghc-e/should_fail/all.T
=====================================
@@ -15,6 +15,7 @@ test('ghc-e-fail2', req_interp, makefile_test, ['ghc-e-fail2'])
test('T9930fail',
[extra_files(['T9930']),
when(opsys('mingw32'), skip),
+ normalise_version('ghc'),
# broken for JS until cross-compilers become stage2 compilers (#19174)
# or until we bootstrap with a 9.10 compiler
js_broken(19174)],
@@ -24,7 +25,7 @@ test('T18441fail0', req_interp, makefile_test, ['T18441fail0'])
test('T18441fail1', req_interp, makefile_test, ['T18441fail1'])
-test('T18441fail2', req_interp, makefile_test, ['T18441fail2'])
+test('T18441fail2', [req_interp, normalise_version('ghc')], makefile_test, ['T18441fail2'])
test('T18441fail3', [ignore_stderr, exit_code(1)], run_command, ['{compiler} -e ":! abcde"'])
@@ -34,9 +35,9 @@ test('T18441fail5', req_interp, makefile_test, ['T18441fail5'])
test('T18441fail6', req_interp, makefile_test, ['T18441fail6'])
-test('T18441fail7', req_interp, makefile_test, ['T18441fail7'])
+test('T18441fail7', [req_interp, normalise_version('ghc')], makefile_test, ['T18441fail7'])
-test('T18441fail8', req_interp, makefile_test, ['T18441fail8'])
+test('T18441fail8', [req_interp, normalise_version('ghc')], makefile_test, ['T18441fail8'])
test('T18441fail9', req_interp, makefile_test, ['T18441fail9'])
@@ -60,6 +61,6 @@ test('T18441fail18', req_interp, makefile_test, ['T18441fail18'])
test('T18441fail19', [ignore_stderr, exit_code(1)], run_command, ['{compiler} -e ":cd abcd"'])
-test('T23663', req_interp, makefile_test, ['T23663'])
+test('T23663', [req_interp, normalise_version('ghc')], makefile_test, ['T23663'])
test('T24172', normal, compile_fail, ['-fdiagnostics-color=always'])
=====================================
utils/haddock/haddock-test/src/Test/Haddock.hs
=====================================
@@ -156,7 +156,7 @@ runHaddock cfg@(Config{..}) = do
files <- filter ((== ".hi") . takeExtension) <$> listDirectory hiDir
-- Use the output order of GHC as a simple dependency order
- filesSorted <- Map.elems . Map.fromList <$> traverse (\file -> (,file) <$> getModificationTime (hiDir </> file)) files
+ filesSorted <- Map.elems . Map.fromList <$> traverse (\file -> (\mt -> ((mt,file),file)) <$> getModificationTime (hiDir </> file)) files
let srcRef = if "--hyperlinked-source" `elem` cfgHaddockArgs then ",src,visible," else ""
loop [] = pure True
loop (file : files) = do
=====================================
utils/haddock/haddock-test/src/Test/Haddock/Xhtml.hs
=====================================
@@ -8,6 +8,7 @@ module Test.Haddock.Xhtml
, stripIdsWhen
, stripFooter
, fixAttrValueWhen
+ , stripVersions
) where
{-
@@ -22,7 +23,7 @@ and since the `xhtml` library already handles the pretty-printing aspect,
this would appear to be a reasonable compromise for now.
-}
-import Data.Char (isSpace)
+import Data.Char (isSpace, isAlphaNum)
import Data.List (isPrefixOf, stripPrefix)
-- | Simple wrapper around the pretty-printed HTML source
@@ -142,3 +143,18 @@ stripFooter (Xml body) = Xml (findDiv body)
Just valRest''
| otherwise =
dropToDiv cs
+
+-- | Strip strings of the form <pkg>-<version>-<hash>
+-- to just <pkg>
+stripVersions :: [String] -> Xml -> Xml
+stripVersions xs (Xml body) = Xml $ foldr id body $ map go xs
+ where
+ go pkg "" = ""
+ go pkg body@(x:body') = case stripPrefix pkg body of
+ Just ('-':rest)
+ | (version,'-':rest') <- span (/= '-') rest
+ , all (`elem` ('.':['0'..'9'])) version
+ , let (hash, rest'') = span isAlphaNum rest'
+ -> pkg ++ go pkg rest''
+ _ -> x:go pkg body'
+
=====================================
utils/haddock/html-test/Main.hs
=====================================
@@ -42,7 +42,7 @@ main = do
stripIfRequired :: String -> Xml -> Xml
stripIfRequired mdl =
- stripLinks' . stripFooter
+ stripLinks' . stripFooter . stripVersions ["base"]
where
stripLinks'
| mdl `elem` preserveLinksModules = id
=====================================
utils/haddock/html-test/ref/Bug1004.html
=====================================
@@ -210,7 +210,7 @@
>D1</a
> ('<a href="#" title="GHC.Generics"
>MetaData</a
- > "Product" "Data.Functor.Product" "base-4.20.0.0-inplace" '<a href="#" title="Data.Bool"
+ > "Product" "Data.Functor.Product" "base" '<a href="#" title="Data.Bool"
>False</a
>) (<a href="#" title="GHC.Generics"
>C1</a
@@ -2037,7 +2037,7 @@
>D1</a
> ('<a href="#" title="GHC.Generics"
>MetaData</a
- > "Product" "Data.Functor.Product" "base-4.20.0.0-inplace" '<a href="#" title="Data.Bool"
+ > "Product" "Data.Functor.Product" "base" '<a href="#" title="Data.Bool"
>False</a
>) (<a href="#" title="GHC.Generics"
>C1</a
@@ -2510,7 +2510,7 @@
>D1</a
> ('<a href="#" title="GHC.Generics"
>MetaData</a
- > "Product" "Data.Functor.Product" "base-4.20.0.0-inplace" '<a href="#" title="Data.Bool"
+ > "Product" "Data.Functor.Product" "base" '<a href="#" title="Data.Bool"
>False</a
>) (<a href="#" title="GHC.Generics"
>C1</a
@@ -2604,7 +2604,7 @@
>D1</a
> ('<a href="#" title="GHC.Generics"
>MetaData</a
- > "Product" "Data.Functor.Product" "base-4.20.0.0-inplace" '<a href="#" title="Data.Bool"
+ > "Product" "Data.Functor.Product" "base" '<a href="#" title="Data.Bool"
>False</a
>) (<a href="#" title="GHC.Generics"
>C1</a
=====================================
utils/haddock/html-test/ref/Bug548.html
=====================================
@@ -186,7 +186,7 @@
>D1</a
> ('<a href="#" title="GHC.Generics"
>MetaData</a
- > "WrappedArrow" "Control.Applicative" "base-4.20.0.0-inplace" '<a href="#" title="Data.Bool"
+ > "WrappedArrow" "Control.Applicative" "base" '<a href="#" title="Data.Bool"
>True</a
>) (<a href="#" title="GHC.Generics"
>C1</a
@@ -792,7 +792,7 @@
>D1</a
> ('<a href="#" title="GHC.Generics"
>MetaData</a
- > "WrappedArrow" "Control.Applicative" "base-4.20.0.0-inplace" '<a href="#" title="Data.Bool"
+ > "WrappedArrow" "Control.Applicative" "base" '<a href="#" title="Data.Bool"
>True</a
>) (<a href="#" title="GHC.Generics"
>C1</a
@@ -903,7 +903,7 @@
>D1</a
> ('<a href="#" title="GHC.Generics"
>MetaData</a
- > "WrappedArrow" "Control.Applicative" "base-4.20.0.0-inplace" '<a href="#" title="Data.Bool"
+ > "WrappedArrow" "Control.Applicative" "base" '<a href="#" title="Data.Bool"
>True</a
>) (<a href="#" title="GHC.Generics"
>C1</a
@@ -973,7 +973,7 @@
>D1</a
> ('<a href="#" title="GHC.Generics"
>MetaData</a
- > "WrappedArrow" "Control.Applicative" "base-4.20.0.0-inplace" '<a href="#" title="Data.Bool"
+ > "WrappedArrow" "Control.Applicative" "base" '<a href="#" title="Data.Bool"
>True</a
>) (<a href="#" title="GHC.Generics"
>C1</a
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bcb1249a580eb1ae6374ee0fd3c479d3e8114b44...380d89bb917085ce4e8dadf441af5e583b488782
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bcb1249a580eb1ae6374ee0fd3c479d3e8114b44...380d89bb917085ce4e8dadf441af5e583b488782
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/20241014/ae9b5d15/attachment-0001.html>
More information about the ghc-commits
mailing list