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
......@@ -413,7 +413,7 @@ test-suite package-tests
regex-posix,
old-time
if !os(windows)
build-depends: unix
build-depends: unix, exceptions
ghc-options: -Wall -rtsopts
default-extensions: CPP
default-language: Haskell98
......@@ -57,6 +57,7 @@ module PackageTests.PackageTester
, assertFindInFile
, concatOutput
, ghcFileModDelay
, withSymlink
-- * Test trees
, TestTreeM
......@@ -126,6 +127,12 @@ import System.Process (runProcess, waitForProcess, showCommandForUser)
import Control.Concurrent (threadDelay)
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
-- suite configuration 'SuiteConfig', and the local per-test
-- configuration 'TestConfig'.
......@@ -741,6 +748,20 @@ ghcFileModDelay = do
= mtimeChangeDelay suite
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
......
......@@ -7,10 +7,13 @@ import qualified PackageTests.TestStanza.Check
import qualified PackageTests.DeterministicAr.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.InstallDirs (CopyDest(NoCopyDest))
import Distribution.Simple.BuildPaths (mkLibName, mkSharedLibName)
import Distribution.Simple.Compiler (compilerId)
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(localPkgDescr, compiler), absoluteComponentInstallDirs
, InstallDirs(libdir), maybeGetComponentLocalBuildInfo
, ComponentLocalBuildInfo(componentUnitId), ComponentName(CLibName) )
import Distribution.Simple.InstallDirs ( CopyDest(NoCopyDest) )
import Distribution.Simple.BuildPaths ( mkLibName, mkSharedLibName )
import Distribution.Simple.Compiler ( compilerId )
import Control.Monad
......@@ -270,9 +273,21 @@ tests config = do
tc "GhcPkgGuess/SameDirectoryGhcVersion" $ ghc_pkg_guess "ghc-7.10"
unlessWindows $ do
tc "GhcPkgGuess/Symlink" $ ghc_pkg_guess "ghc"
tc "GhcPkgGuess/SymlinkVersion" $ ghc_pkg_guess "ghc"
tc "GhcPkgGuess/SymlinkGhcVersion" $ ghc_pkg_guess "ghc"
tc "GhcPkgGuess/Symlink" $ do
-- We don't want to distribute a tarball with symlinks. See #3190.
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
-- sure that the internal library correctly is used, not the
......@@ -291,12 +306,14 @@ tests config = do
-- this does build shared libraries just to make sure they
-- don't get installed, so this test doesn't work on Windows.)
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:
-- ONLY the dynamic library should be installed, no registration
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
-- registered.
......@@ -393,7 +410,8 @@ tests config = do
cname = (CLibName "foo-internal")
Just clbi = maybeGetComponentLocalBuildInfo lbi cname
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
=<< liftIO (doesFileExist (dir </> "Foo.hi"))
assertBool "static library should NOT be installed" . not
......@@ -401,10 +419,12 @@ tests config = do
if is_dynamic
then
assertBool "dynamic library MUST be installed"
=<< liftIO (doesFileExist (dir </> mkSharedLibName compiler_id uid))
=<< liftIO (doesFileExist (dir </> mkSharedLibName
compiler_id uid))
else
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"]
-- clean away the dist directory so that we catch accidental
-- dependence on the inplace files
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment