Skip to content
Snippets Groups Projects
Commit d90e338c authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Merge pull request #3299 from 23Skidoo/issue-3190

Test suite: create symlinks as needed.
parents 7ddeb76f e4d7536f
No related branches found
No related tags found
No related merge requests found
...@@ -413,7 +413,7 @@ test-suite package-tests ...@@ -413,7 +413,7 @@ test-suite package-tests
regex-posix, regex-posix,
old-time old-time
if !os(windows) if !os(windows)
build-depends: unix build-depends: unix, exceptions
ghc-options: -Wall -rtsopts ghc-options: -Wall -rtsopts
default-extensions: CPP default-extensions: CPP
default-language: Haskell98 default-language: Haskell98
bin/ghc
\ No newline at end of file
bin/ghc-7.10
\ No newline at end of file
bin/ghc-7.10
\ No newline at end of file
...@@ -57,6 +57,7 @@ module PackageTests.PackageTester ...@@ -57,6 +57,7 @@ module PackageTests.PackageTester
, assertFindInFile , assertFindInFile
, concatOutput , concatOutput
, ghcFileModDelay , ghcFileModDelay
, withSymlink
-- * Test trees -- * Test trees
, TestTreeM , TestTreeM
...@@ -126,6 +127,12 @@ import System.Process (runProcess, waitForProcess, showCommandForUser) ...@@ -126,6 +127,12 @@ import System.Process (runProcess, waitForProcess, showCommandForUser)
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import Test.Tasty (TestTree, askOption, testGroup) import Test.Tasty (TestTree, askOption, testGroup)
#ifndef mingw32_HOST_OS
import Control.Monad.Catch ( bracket_ )
import System.Directory ( removeFile )
import System.Posix.Files ( createSymbolicLink )
#endif
-- | Our test monad maintains an environment recording the global test -- | Our test monad maintains an environment recording the global test
-- suite configuration 'SuiteConfig', and the local per-test -- suite configuration 'SuiteConfig', and the local per-test
-- configuration 'TestConfig'. -- configuration 'TestConfig'.
...@@ -741,6 +748,20 @@ ghcFileModDelay = do ...@@ -741,6 +748,20 @@ ghcFileModDelay = do
= mtimeChangeDelay suite = mtimeChangeDelay suite
liftIO $ threadDelay delay liftIO $ threadDelay delay
-- | Create a symlink for the duration of the provided action. If the symlink
-- already exists, it is deleted. Does not work on Windows.
withSymlink :: FilePath -> FilePath -> TestM a -> TestM a
#ifdef mingw32_HOST_OS
withSymlink _oldpath _newpath _act =
error "PackageTests.PackageTester.withSymlink: does not work on Windows!"
#else
withSymlink oldpath newpath act = do
symlinkExists <- liftIO $ doesFileExist newpath
when symlinkExists $ liftIO $ removeFile newpath
bracket_ (liftIO $ createSymbolicLink oldpath newpath)
(liftIO $ removeFile newpath) act
#endif
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- * Test trees -- * Test trees
......
...@@ -7,10 +7,13 @@ import qualified PackageTests.TestStanza.Check ...@@ -7,10 +7,13 @@ import qualified PackageTests.TestStanza.Check
import qualified PackageTests.DeterministicAr.Check import qualified PackageTests.DeterministicAr.Check
import qualified PackageTests.TestSuiteTests.ExeV10.Check import qualified PackageTests.TestSuiteTests.ExeV10.Check
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(localPkgDescr, compiler), absoluteComponentInstallDirs, InstallDirs(libdir), maybeGetComponentLocalBuildInfo, ComponentLocalBuildInfo(componentUnitId), ComponentName(CLibName)) import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.InstallDirs (CopyDest(NoCopyDest)) ( LocalBuildInfo(localPkgDescr, compiler), absoluteComponentInstallDirs
import Distribution.Simple.BuildPaths (mkLibName, mkSharedLibName) , InstallDirs(libdir), maybeGetComponentLocalBuildInfo
import Distribution.Simple.Compiler (compilerId) , ComponentLocalBuildInfo(componentUnitId), ComponentName(CLibName) )
import Distribution.Simple.InstallDirs ( CopyDest(NoCopyDest) )
import Distribution.Simple.BuildPaths ( mkLibName, mkSharedLibName )
import Distribution.Simple.Compiler ( compilerId )
import Control.Monad import Control.Monad
...@@ -270,9 +273,21 @@ tests config = do ...@@ -270,9 +273,21 @@ tests config = do
tc "GhcPkgGuess/SameDirectoryGhcVersion" $ ghc_pkg_guess "ghc-7.10" tc "GhcPkgGuess/SameDirectoryGhcVersion" $ ghc_pkg_guess "ghc-7.10"
unlessWindows $ do unlessWindows $ do
tc "GhcPkgGuess/Symlink" $ ghc_pkg_guess "ghc" tc "GhcPkgGuess/Symlink" $ do
tc "GhcPkgGuess/SymlinkVersion" $ ghc_pkg_guess "ghc" -- We don't want to distribute a tarball with symlinks. See #3190.
tc "GhcPkgGuess/SymlinkGhcVersion" $ ghc_pkg_guess "ghc" withSymlink "bin/ghc"
"tests/PackageTests/GhcPkgGuess/Symlink/ghc" $
ghc_pkg_guess "ghc"
tc "GhcPkgGuess/SymlinkVersion" $ do
withSymlink "bin/ghc-7.10"
"tests/PackageTests/GhcPkgGuess/SymlinkVersion/ghc" $
ghc_pkg_guess "ghc"
tc "GhcPkgGuess/SymlinkGhcVersion" $ do
withSymlink "bin/ghc-7.10"
"tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/ghc" $
ghc_pkg_guess "ghc"
-- Basic test for internal libraries (in p); package q is to make -- Basic test for internal libraries (in p); package q is to make
-- sure that the internal library correctly is used, not the -- sure that the internal library correctly is used, not the
...@@ -291,12 +306,14 @@ tests config = do ...@@ -291,12 +306,14 @@ tests config = do
-- this does build shared libraries just to make sure they -- this does build shared libraries just to make sure they
-- don't get installed, so this test doesn't work on Windows.) -- don't get installed, so this test doesn't work on Windows.)
testWhen (hasSharedLibraries config) $ testWhen (hasSharedLibraries config) $
tcs "InternalLibraries/Executable" "Static" $ multiple_libraries_executable False tcs "InternalLibraries/Executable" "Static" $
multiple_libraries_executable False
-- Internal libraries used by a dynamically linked executable: -- Internal libraries used by a dynamically linked executable:
-- ONLY the dynamic library should be installed, no registration -- ONLY the dynamic library should be installed, no registration
testWhen (hasSharedLibraries config) $ testWhen (hasSharedLibraries config) $
tcs "InternalLibraries/Executable" "Dynamic" $ multiple_libraries_executable True tcs "InternalLibraries/Executable" "Dynamic" $
multiple_libraries_executable True
-- Internal library used by public library; it must be installed and -- Internal library used by public library; it must be installed and
-- registered. -- registered.
...@@ -393,7 +410,8 @@ tests config = do ...@@ -393,7 +410,8 @@ tests config = do
cname = (CLibName "foo-internal") cname = (CLibName "foo-internal")
Just clbi = maybeGetComponentLocalBuildInfo lbi cname Just clbi = maybeGetComponentLocalBuildInfo lbi cname
uid = componentUnitId clbi uid = componentUnitId clbi
dir = libdir (absoluteComponentInstallDirs pkg_descr lbi uid NoCopyDest) dir = libdir (absoluteComponentInstallDirs pkg_descr lbi uid
NoCopyDest)
assertBool "interface files should NOT be installed" . not assertBool "interface files should NOT be installed" . not
=<< liftIO (doesFileExist (dir </> "Foo.hi")) =<< liftIO (doesFileExist (dir </> "Foo.hi"))
assertBool "static library should NOT be installed" . not assertBool "static library should NOT be installed" . not
...@@ -401,10 +419,12 @@ tests config = do ...@@ -401,10 +419,12 @@ tests config = do
if is_dynamic if is_dynamic
then then
assertBool "dynamic library MUST be installed" assertBool "dynamic library MUST be installed"
=<< liftIO (doesFileExist (dir </> mkSharedLibName compiler_id uid)) =<< liftIO (doesFileExist (dir </> mkSharedLibName
compiler_id uid))
else else
assertBool "dynamic library should NOT be installed" . not assertBool "dynamic library should NOT be installed" . not
=<< liftIO (doesFileExist (dir </> mkSharedLibName compiler_id uid)) =<< liftIO (doesFileExist (dir </> mkSharedLibName
compiler_id uid))
shouldFail $ ghcPkg "describe" ["foo"] shouldFail $ ghcPkg "describe" ["foo"]
-- clean away the dist directory so that we catch accidental -- clean away the dist directory so that we catch accidental
-- dependence on the inplace files -- dependence on the inplace files
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment