diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,8 +1,6 @@ module Main (main) where import Distribution.Simple -import Distribution.Simple.Program (simpleProgram) main :: IO () main = defaultMainWithHooks autoconfUserHooks - { hookedPrograms = [simpleProgram "python", simpleProgram "which"] } diff --git a/System/Directory.hs b/System/Directory.hs --- a/System/Directory.hs +++ b/System/Directory.hs @@ -1,7 +1,4 @@ {-# LANGUAGE CPP, NondecreasingIndentation #-} -#ifdef __GLASGOW_HASKELL__ -{-# LANGUAGE Trustworthy #-} -#endif ----------------------------------------------------------------------------- -- | @@ -27,13 +24,16 @@ , removeDirectory , removeDirectoryRecursive , renameDirectory - , getDirectoryContents + -- ** Current working directory , getCurrentDirectory , setCurrentDirectory + , withCurrentDirectory -- * Pre-defined directories , getHomeDirectory + , XdgDirectory(..) + , getXdgDirectory , getAppUserDataDirectory , getUserDocumentsDirectory , getTemporaryDirectory @@ -77,34 +77,62 @@ -- * Timestamps + , getAccessTime , getModificationTime + , setAccessTime + , setModificationTime + ) where +import Control.Exception ( bracket, bracketOnError ) +import Control.Monad ( when, unless ) +#if !MIN_VERSION_base(4, 8, 0) +import Data.Functor ((<$>)) +#endif +import Data.Maybe + ( listToMaybe +#ifdef mingw32_HOST_OS + , maybeToList +#endif + ) +import Data.Tuple (swap) import System.FilePath import System.IO import System.IO.Error -import Control.Monad ( when, unless ) -import Control.Exception.Base as E + ( catchIOError + , ioeSetErrorString + , ioeSetFileName + , ioeSetLocation + , isAlreadyExistsError + , isDoesNotExistError + , isPermissionError + , mkIOError + , modifyIOError + , tryIOError ) #ifdef __HUGS__ import Hugs.Directory #endif /* __HUGS__ */ import Foreign -import Foreign.C {-# CFILES cbits/directory.c #-} -import Data.Maybe - import Data.Time ( UTCTime ) -import Data.Time.Clock.POSIX ( posixSecondsToUTCTime ) +import Data.Time.Clock.POSIX + ( posixSecondsToUTCTime + , utcTimeToPOSIXSeconds +#ifdef mingw32_HOST_OS + , POSIXTime +#endif + ) #ifdef __GLASGOW_HASKELL__ import GHC.IO.Exception ( IOErrorType(InappropriateType) ) #ifdef mingw32_HOST_OS +import Foreign.C import System.Posix.Types import System.Posix.Internals import qualified System.Win32 as Win32 @@ -115,8 +143,28 @@ import qualified System.Posix as Posix #endif +#include +#ifdef HAVE_UTIMENSAT +import Foreign.C (throwErrnoPathIfMinus1_) +import System.Posix.Internals ( withFilePath ) +#endif + #endif /* __GLASGOW_HASKELL__ */ +import System.Directory.Internal + +#ifdef mingw32_HOST_OS +win32_cSIDL_LOCAL_APPDATA :: Win32.CSIDL +win32_fILE_SHARE_DELETE :: Win32.ShareMode +#if MIN_VERSION_Win32(2, 3, 1) +win32_cSIDL_LOCAL_APPDATA = Win32.cSIDL_LOCAL_APPDATA -- only on HEAD atm +win32_fILE_SHARE_DELETE = Win32.fILE_SHARE_DELETE -- added in 2.3.0.2 +#else +win32_cSIDL_LOCAL_APPDATA = 0x001c +win32_fILE_SHARE_DELETE = 0x00000004 +#endif +#endif + {- $intro A directory contains a series of entries, each of which is a named reference to a file system object (file, directory etc.). Some @@ -369,16 +417,15 @@ parents = reverse . scanl1 () . splitDirectories . normalise createDirs [] = return () - createDirs (dir:[]) = createDir dir throwIO + createDirs (dir:[]) = createDir dir ioError createDirs (dir:dirs) = createDir dir $ \_ -> do createDirs dirs - createDir dir throwIO + createDir dir ioError - createDir :: FilePath -> (IOException -> IO ()) -> IO () createDir dir notExistHandler = do - r <- E.try $ createDirectory dir - case (r :: Either IOException ()) of + r <- tryIOError (createDirectory dir) + case r of Right () -> return () Left e | isDoesNotExistError e -> notExistHandler e @@ -396,16 +443,17 @@ -- This caused GHCi to crash when loading a module in the root -- directory. | isAlreadyExistsError e - || isPermissionError e -> do + || isPermissionError e -> do + canIgnore <- isDir `catchIOError` \ _ -> + return (isAlreadyExistsError e) + unless canIgnore (ioError e) + | otherwise -> ioError e + where #ifdef mingw32_HOST_OS - canIgnore <- (withFileStatus "createDirectoryIfMissing" dir isDirectory) + isDir = withFileStatus "createDirectoryIfMissing" dir isDirectory #else - canIgnore <- (Posix.isDirectory `fmap` Posix.getFileStatus dir) + isDir = (Posix.isDirectory <$> Posix.getFileStatus dir) #endif - `E.catch` ((\ _ -> return (isAlreadyExistsError e)) - :: IOException -> IO Bool) - unless canIgnore (throwIO e) - | otherwise -> throwIO e #if __GLASGOW_HASKELL__ @@ -422,7 +470,7 @@ getDirectoryType path = (`ioeSetLocation` "getDirectoryType") `modifyIOError` do #ifdef mingw32_HOST_OS - fmap classify (Win32.getFileAttributes path) + classify <$> Win32.getFileAttributes path where fILE_ATTRIBUTE_REPARSE_POINT = 0x400 classify attr | attr .&. Win32.fILE_ATTRIBUTE_DIRECTORY == 0 = NotDirectory @@ -487,8 +535,8 @@ #endif -- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/ --- together with its contents and subdirectories. Symbolic links are removed --- without affecting their the targets. +-- together with its contents and subdirectories. Within this directory, +-- symbolic links are removed without affecting their the targets. removeDirectoryRecursive :: FilePath -> IO () removeDirectoryRecursive path = (`ioeSetLocation` "removeDirectoryRecursive") `modifyIOError` do @@ -716,7 +764,7 @@ copyFile :: FilePath -> FilePath -> IO () copyFile fromFPath toFPath = - copy `catchIOError` (\exc -> throwIO $ ioeSetLocation exc "copyFile") + copy `catchIOError` (\ exc -> ioError (ioeSetLocation exc "copyFile")) where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom -> bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) -> do allocaBytes bufferSize $ copyContents hFrom hTmp @@ -737,61 +785,87 @@ ignoreIOExceptions io = io `catchIOError` (\_ -> return ()) --- | Canonicalize the path of an existing file or directory. The intent is --- that two paths referring to the same file\/directory will map to the same --- canonicalized path. +-- | Make a path absolute and remove as many indirections from it as possible. +-- Indirections include the two special directories @.@ and @..@, as well as +-- any symbolic links. The input path need not point to an existing file or +-- directory. -- --- __Note__: if you only require an absolute path, consider using --- @'makeAbsolute'@ instead, which is more reliable and does not have --- unspecified behavior on nonexistent paths. +-- __Note__: if you require only an absolute path, use 'makeAbsolute' instead. +-- Most programs need not care about whether a path contains symbolic links. -- --- It is impossible to guarantee that the implication (same file\/dir \<=\> --- same canonicalized path) holds in either direction: this function can make --- only a best-effort attempt. +-- Due to the fact that symbolic links and @..@ are dependent on the state of +-- the existing filesystem, the function can only make a conservative, +-- best-effort attempt. Nevertheless, if the input path points to an existing +-- file or directory, then the output path shall also point to the same file +-- or directory. -- --- The precise behaviour is that of the POSIX @realpath@ function (or --- @GetFullPathNameW@ on Windows). In particular, the behaviour on paths that --- don't exist can vary from platform to platform. Some platforms do not --- alter the input, some do, and some throw an exception. +-- Formally, symbolic links and @..@ are removed from the longest prefix of +-- the path that still points to an existing file. The function is not +-- atomic, therefore concurrent changes in the filesystem may lead to +-- incorrect results. -- --- An empty path is considered to be equivalent to the current directory. +-- (Despite the name, the function does not guarantee canonicity of the +-- returned path due to the presence of hard links, mount points, etc.) -- --- /Known bug(s)/: on Windows, this function does not resolve symbolic links. +-- Similar to 'normalise', an empty path is equivalent to the current +-- directory. -- +-- /Known bug(s)/: on Windows, the function does not resolve symbolic links. +-- +-- /Changes since 1.2.3.0:/ The function has been altered to be more robust +-- and has the same exception behavior as 'makeAbsolute'. +-- canonicalizePath :: FilePath -> IO FilePath -canonicalizePath "" = canonicalizePath "." -canonicalizePath fpath = +canonicalizePath = \ path -> + modifyIOError ((`ioeSetLocation` "canonicalizePath") . + (`ioeSetFileName` path)) $ + -- normalise does more stuff, like upper-casing the drive letter + normalise <$> (transform =<< makeAbsolute path) + where #if defined(mingw32_HOST_OS) - do path <- Win32.getFullPathName fpath + transform path = Win32.getFullPathName path + `catchIOError` \ _ -> return path #else - do enc <- getFileSystemEncoding - GHC.withCString enc fpath $ \pInPath -> - allocaBytes long_path_size $ \pOutPath -> - do _ <- throwErrnoPathIfNull "canonicalizePath" fpath $ c_realpath pInPath pOutPath + transform path = copySlash path <$> do + encoding <- getFileSystemEncoding + realpathPrefix encoding (reverse (zip prefixes suffixes)) path + where segments = splitPath path + prefixes = scanl1 () segments + suffixes = tail (scanr () "" segments) - -- NB: pOutPath will be passed thru as result pointer by c_realpath - path <- GHC.peekCString enc pOutPath -#endif - return (normalise path) - -- normalise does more stuff, like upper-casing the drive letter + -- call realpath on the largest possible prefix + realpathPrefix encoding ((prefix, suffix) : rest) path = do + exist <- doesPathExist prefix + if exist -- never call realpath on an inaccessible path + then (( suffix) <$> realpath encoding prefix) + `catchIOError` \ _ -> realpathPrefix encoding rest path + else realpathPrefix encoding rest path + realpathPrefix _ _ path = return path -#if !defined(mingw32_HOST_OS) -foreign import ccall unsafe "realpath" - c_realpath :: CString - -> CString - -> IO CString + realpath encoding path = + GHC.withCString encoding path + (`withRealpath` GHC.peekCString encoding) + + doesPathExist path = (Posix.getFileStatus path >> return True) + `catchIOError` \ _ -> return False + + -- make sure trailing slash is preserved + copySlash path | hasTrailingPathSeparator path = addTrailingPathSeparator + | otherwise = id #endif -- | Make a path absolute by prepending the current directory (if it isn't --- already absolute) and applying @'normalise'@ to the result. +-- already absolute) and applying 'normalise' to the result. -- --- The operation may fail with the same exceptions as @'getCurrentDirectory'@. +-- If the path is already absolute, the operation never fails. Otherwise, the +-- operation may fail with the same exceptions as 'getCurrentDirectory'. -- --- /Since: 1.2.2.0/ +-- @since 1.2.2.0 makeAbsolute :: FilePath -> IO FilePath -makeAbsolute = fmap normalise . absolutize +makeAbsolute = (normalise <$>) . absolutize where absolutize path -- avoid the call to `getCurrentDirectory` if we can - | isRelative path = fmap ( path) getCurrentDirectory + | isRelative path = ( path) . addTrailingPathSeparator <$> + getCurrentDirectory | otherwise = return path -- | 'makeRelative' the current directory. @@ -826,11 +900,11 @@ -- | Given a file name, searches for the file and returns a list of all -- occurences that are executable. -- --- /Since: 1.2.2.0/ +-- @since 1.2.2.0 findExecutables :: String -> IO [FilePath] findExecutables binary = do #if defined(mingw32_HOST_OS) - file <- Win32.searchPath Nothing binary ('.':exeExtension) + file <- Win32.searchPath Nothing binary exeExtension return $ maybeToList file #else path <- getEnv "PATH" @@ -850,7 +924,7 @@ -- | Search through the given set of directories for the given file and -- returns a list of paths where the given file exists. -- --- /Since: 1.2.1.0/ +-- @since 1.2.1.0 findFiles :: [FilePath] -> String -> IO [FilePath] findFiles = findFilesWith (\_ -> return True) @@ -858,7 +932,7 @@ -- with the given property (usually permissions) and returns a list of -- paths where the given file exists and has the property. -- --- /Since: 1.2.1.0/ +-- @since 1.2.1.0 findFilesWith :: (FilePath -> IO Bool) -> [FilePath] -> String -> IO [FilePath] findFilesWith _ [] _ = return [] findFilesWith f (d:ds) fileName = do @@ -941,36 +1015,33 @@ #endif /* __GLASGOW_HASKELL__ */ -{- |If the operating system has a notion of current directories, -'getCurrentDirectory' returns an absolute path to the -current directory of the calling process. - -The operation may fail with: - -* 'HardwareFault' -A physical I\/O error has occurred. -@[EIO]@ - -* 'isDoesNotExistError' \/ 'NoSuchThing' -There is no path referring to the current directory. -@[EPERM, ENOENT, ESTALE...]@ - -* 'isPermissionError' \/ 'PermissionDenied' -The process has insufficient privileges to perform the operation. -@[EACCES]@ - -* 'ResourceExhausted' -Insufficient resources are available to perform the operation. - -* 'UnsupportedOperation' -The operating system has no notion of current directory. - -Note that in a concurrent program, the current directory is global -state shared between all threads of the process. When using -filesystem operations from multiple threads, it is therefore highly -recommended to use absolute rather than relative `FilePath`s. - --} +-- | Obtain the current working directory as an absolute path. +-- +-- In a multithreaded program, the current working directory is a global state +-- shared among all threads of the process. Therefore, when performing +-- filesystem operations from multiple threads, it is highly recommended to +-- use absolute rather than relative paths (see: 'makeAbsolute'). +-- +-- The operation may fail with: +-- +-- * 'HardwareFault' +-- A physical I\/O error has occurred. +-- @[EIO]@ +-- +-- * 'isDoesNotExistError' or 'NoSuchThing' +-- There is no path referring to the working directory. +-- @[EPERM, ENOENT, ESTALE...]@ +-- +-- * 'isPermissionError' or 'PermissionDenied' +-- The process has insufficient privileges to perform the operation. +-- @[EACCES]@ +-- +-- * 'ResourceExhausted' +-- Insufficient resources are available to perform the operation. +-- +-- * 'UnsupportedOperation' +-- The operating system has no notion of current working directory. +-- #ifdef __GLASGOW_HASKELL__ getCurrentDirectory :: IO FilePath getCurrentDirectory = do @@ -980,54 +1051,64 @@ Posix.getWorkingDirectory #endif -{- |If the operating system has a notion of current directories, -@'setCurrentDirectory' dir@ changes the current -directory of the calling process to /dir/. - -The operation may fail with: - -* 'HardwareFault' -A physical I\/O error has occurred. -@[EIO]@ - -* 'InvalidArgument' -The operand is not a valid directory name. -@[ENAMETOOLONG, ELOOP]@ - -* 'isDoesNotExistError' \/ 'NoSuchThing' -The directory does not exist. -@[ENOENT, ENOTDIR]@ - -* 'isPermissionError' \/ 'PermissionDenied' -The process has insufficient privileges to perform the operation. -@[EACCES]@ - -* 'UnsupportedOperation' -The operating system has no notion of current directory, or the -current directory cannot be dynamically changed. - -* 'InappropriateType' -The path refers to an existing non-directory object. -@[ENOTDIR]@ - -Note that in a concurrent program, the current directory is global -state shared between all threads of the process. When using -filesystem operations from multiple threads, it is therefore highly -recommended to use absolute rather than relative `FilePath`s. - --} - +-- | Change the working directory to the given path. +-- +-- In a multithreaded program, the current working directory is a global state +-- shared among all threads of the process. Therefore, when performing +-- filesystem operations from multiple threads, it is highly recommended to +-- use absolute rather than relative paths (see: 'makeAbsolute'). +-- +-- The operation may fail with: +-- +-- * 'HardwareFault' +-- A physical I\/O error has occurred. +-- @[EIO]@ +-- +-- * 'InvalidArgument' +-- The operand is not a valid directory name. +-- @[ENAMETOOLONG, ELOOP]@ +-- +-- * 'isDoesNotExistError' or 'NoSuchThing' +-- The directory does not exist. +-- @[ENOENT, ENOTDIR]@ +-- +-- * 'isPermissionError' or 'PermissionDenied' +-- The process has insufficient privileges to perform the operation. +-- @[EACCES]@ +-- +-- * 'UnsupportedOperation' +-- The operating system has no notion of current working directory, or the +-- working directory cannot be dynamically changed. +-- +-- * 'InappropriateType' +-- The path refers to an existing non-directory object. +-- @[ENOTDIR]@ +-- setCurrentDirectory :: FilePath -> IO () -setCurrentDirectory path = +setCurrentDirectory = #ifdef mingw32_HOST_OS - Win32.setCurrentDirectory path + Win32.setCurrentDirectory #else - Posix.changeWorkingDirectory path + Posix.changeWorkingDirectory #endif -#endif /* __GLASGOW_HASKELL__ */ +-- | Run an 'IO' action with the given working directory and restore the +-- original working directory afterwards, even if the given action fails due +-- to an exception. +-- +-- The operation may fail with the same exceptions as 'getCurrentDirectory' +-- and 'setCurrentDirectory'. +-- +-- @since 1.2.3.0 +-- +withCurrentDirectory :: FilePath -- ^ Directory to execute in + -> IO a -- ^ Action to be executed + -> IO a +withCurrentDirectory dir action = + bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do + setCurrentDirectory dir + action -#ifdef __GLASGOW_HASKELL__ {- |The operation 'doesDirectoryExist' returns 'True' if the argument file exists and is either a directory or a symbolic link to a directory, and 'False' otherwise. @@ -1041,7 +1122,7 @@ (do stat <- Posix.getFileStatus name return (Posix.isDirectory stat)) #endif - `E.catch` ((\ _ -> return False) :: IOException -> IO Bool) + `catchIOError` \ _ -> return False {- |The operation 'doesFileExist' returns 'True' if the argument file exists and is not a directory, and 'False' otherwise. @@ -1055,47 +1136,197 @@ (do stat <- Posix.getFileStatus name return (not (Posix.isDirectory stat))) #endif - `E.catch` ((\ _ -> return False) :: IOException -> IO Bool) - -{- |The 'getModificationTime' operation returns the -clock time at which the file or directory was last modified. - -The operation may fail with: - -* 'isPermissionError' if the user is not permitted to access - the modification time; or + `catchIOError` \ _ -> return False -* 'isDoesNotExistError' if the file or directory does not exist. +#ifdef mingw32_HOST_OS +-- | Open the handle of an existing file or directory. +openFileHandle :: String -> Win32.AccessMode -> IO Win32.HANDLE +openFileHandle path mode = Win32.createFile path mode share Nothing + Win32.oPEN_EXISTING flags Nothing + where share = win32_fILE_SHARE_DELETE + .|. Win32.fILE_SHARE_READ + .|. Win32.fILE_SHARE_WRITE + flags = Win32.fILE_ATTRIBUTE_NORMAL + .|. Win32.fILE_FLAG_BACKUP_SEMANTICS -- required for directories +#endif -Note: This function returns a timestamp with sub-second resolution -only if this package is compiled against @unix-2.6.0.0@ or later -for unix systems, and @Win32-2.3.1.0@ or later for windows systems. -Of course this also requires that the underlying file system supports -such high resolution timestamps. --} +-- | Obtain the time at which the file or directory was last accessed. +-- +-- The operation may fail with: +-- +-- * 'isPermissionError' if the user is not permitted to read +-- the access time; or +-- +-- * 'isDoesNotExistError' if the file or directory does not exist. +-- +-- Caveat for POSIX systems: This function returns a timestamp with sub-second +-- resolution only if this package is compiled against @unix-2.6.0.0@ or later +-- and the underlying filesystem supports them. +-- +-- @since 1.2.3.0 +-- +getAccessTime :: FilePath -> IO UTCTime +getAccessTime = modifyIOError (`ioeSetLocation` "getAccessTime") . + getFileTime False +-- | Obtain the time at which the file or directory was last modified. +-- +-- The operation may fail with: +-- +-- * 'isPermissionError' if the user is not permitted to read +-- the modification time; or +-- +-- * 'isDoesNotExistError' if the file or directory does not exist. +-- +-- Caveat for POSIX systems: This function returns a timestamp with sub-second +-- resolution only if this package is compiled against @unix-2.6.0.0@ or later +-- and the underlying filesystem supports them. +-- getModificationTime :: FilePath -> IO UTCTime -getModificationTime name = do +getModificationTime = modifyIOError (`ioeSetLocation` "getModificationTime") . + getFileTime True + +getFileTime :: Bool -> FilePath -> IO UTCTime +getFileTime isMtime path = modifyIOError (`ioeSetFileName` path) $ + posixSecondsToUTCTime <$> getTime + where + path' = normalise path -- handle empty paths #ifdef mingw32_HOST_OS -#if MIN_VERSION_Win32(2,3,1) - fad <- Win32.getFileAttributesExStandard name - let win32_epoch_adjust = 116444736000000000 - Win32.FILETIME ft = Win32.fadLastWriteTime fad - mod_time = fromIntegral (ft - win32_epoch_adjust) / 10000000 + getTime = + bracket (openFileHandle path' Win32.gENERIC_READ) + Win32.closeHandle $ \ handle -> + alloca $ \ time -> do + Win32.failIf_ not "" . + uncurry (Win32.c_GetFileTime handle nullPtr) $ + swapIf isMtime (time, nullPtr) + windowsToPosixTime <$> peek time #else - mod_time <- withFileStatus "getModificationTime" name $ \stat -> do - mtime <- st_mtime stat - return $ realToFrac (mtime :: CTime) + getTime = convertTime <$> Posix.getFileStatus path' +# if MIN_VERSION_unix(2, 6, 0) + convertTime = if isMtime then Posix.modificationTimeHiRes + else Posix.accessTimeHiRes +# else + convertTime = realToFrac . if isMtime then Posix.modificationTime + else Posix.accessTime +# endif #endif -#else - stat <- Posix.getFileStatus name -#if MIN_VERSION_unix(2,6,0) - let mod_time = Posix.modificationTimeHiRes stat + +-- | Change the time at which the file or directory was last accessed. +-- +-- The operation may fail with: +-- +-- * 'isPermissionError' if the user is not permitted to alter the +-- access time; or +-- +-- * 'isDoesNotExistError' if the file or directory does not exist. +-- +-- Some caveats for POSIX systems: +-- +-- * Not all systems support @utimensat@, in which case the function can only +-- emulate the behavior by reading the modification time and then setting +-- both the access and modification times together. On systems where +-- @utimensat@ is supported, the access time is set atomically with +-- nanosecond precision. +-- +-- * If compiled against a version of @unix@ prior to @2.7.0.0@, the function +-- would not be able to set timestamps with sub-second resolution. In this +-- case, there would also be loss of precision in the modification time. +-- +-- @since 1.2.3.0 +-- +setAccessTime :: FilePath -> UTCTime -> IO () +setAccessTime path = + modifyIOError (`ioeSetLocation` "setAccessTime") . + setFileTime False path + +-- | Change the time at which the file or directory was last modified. +-- +-- The operation may fail with: +-- +-- * 'isPermissionError' if the user is not permitted to alter the +-- modification time; or +-- +-- * 'isDoesNotExistError' if the file or directory does not exist. +-- +-- Some caveats for POSIX systems: +-- +-- * Not all systems support @utimensat@, in which case the function can only +-- emulate the behavior by reading the access time and then setting both the +-- access and modification times together. On systems where @utimensat@ is +-- supported, the modification time is set atomically with nanosecond +-- precision. +-- +-- * If compiled against a version of @unix@ prior to @2.7.0.0@, the function +-- would not be able to set timestamps with sub-second resolution. In this +-- case, there would also be loss of precision in the access time. +-- +-- @since 1.2.3.0 +-- +setModificationTime :: FilePath -> UTCTime -> IO () +setModificationTime path = + modifyIOError (`ioeSetLocation` "setModificationTime") . + setFileTime True path + +setFileTime :: Bool -> FilePath -> UTCTime -> IO () +setFileTime isMtime path = modifyIOError (`ioeSetFileName` path) . + setTime . utcTimeToPOSIXSeconds + where + path' = normalise path -- handle empty paths +#ifdef mingw32_HOST_OS + setTime time = + bracket (openFileHandle path' Win32.gENERIC_WRITE) + Win32.closeHandle $ \ handle -> + with (posixToWindowsTime time) $ \ time' -> + Win32.failIf_ not "" . + uncurry (Win32.c_SetFileTime handle nullPtr) $ + swapIf isMtime (time', nullPtr) +#elif defined HAVE_UTIMENSAT + setTime time = + withFilePath path' $ \ path'' -> + withArray [atime, mtime] $ \ times -> + throwErrnoPathIfMinus1_ "" path' $ + c_utimensat c_AT_FDCWD path'' times 0 + where (atime, mtime) = swapIf isMtime (toCTimeSpec time, utimeOmit) #else - let mod_time = realToFrac $ Posix.modificationTime stat + setTime time = do + stat <- Posix.getFileStatus path' + uncurry (setFileTimes path') $ + swapIf isMtime (convertTime time, otherTime stat) +# if MIN_VERSION_unix(2, 7, 0) + setFileTimes = Posix.setFileTimesHiRes + convertTime = id + otherTime = if isMtime + then Posix.accessTimeHiRes + else Posix.modificationTimeHiRes +# else + setFileTimes = Posix.setFileTimes + convertTime = fromInteger . truncate + otherTime = if isMtime + then Posix.accessTime + else Posix.modificationTime +# endif #endif + +swapIf :: Bool -> (a, a) -> (a, a) +swapIf True = swap +swapIf False = id + +#ifdef mingw32_HOST_OS +-- | Difference between the Windows and POSIX epochs in units of 100ns. +windowsPosixEpochDifference :: Num a => a +windowsPosixEpochDifference = 116444736000000000 + +-- | Convert from Windows time to POSIX time. +windowsToPosixTime :: Win32.FILETIME -> POSIXTime +windowsToPosixTime (Win32.FILETIME t) = + (fromIntegral t - windowsPosixEpochDifference) / 10000000 + +-- | Convert from POSIX time to Windows time. This is lossy as Windows time +-- has a resolution of only 100ns. +posixToWindowsTime :: POSIXTime -> Win32.FILETIME +posixToWindowsTime t = Win32.FILETIME $ + truncate (t * 10000000 + windowsPosixEpochDifference) #endif - return $ posixSecondsToUTCTime mod_time #endif /* __GLASGOW_HASKELL__ */ @@ -1116,34 +1347,18 @@ fileNameEndClean :: String -> String fileNameEndClean name = if isDrive name then addTrailingPathSeparator name else dropTrailingPathSeparator name - -foreign import ccall unsafe "HsDirectory.h __hscore_S_IRUSR" s_IRUSR :: CMode -foreign import ccall unsafe "HsDirectory.h __hscore_S_IWUSR" s_IWUSR :: CMode -foreign import ccall unsafe "HsDirectory.h __hscore_S_IXUSR" s_IXUSR :: CMode -foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode #endif -#ifndef mingw32_HOST_OS -#ifdef __GLASGOW_HASKELL__ -foreign import ccall unsafe "__hscore_long_path_size" - long_path_size :: Int -#else -long_path_size :: Int -long_path_size = 2048 -- // guess? -#endif /* __GLASGOW_HASKELL__ */ -#endif /* !mingw32_HOST_OS */ - {- | Returns the current user's home directory. The directory returned is expected to be writable by the current user, but note that it isn't generally considered good practice to store -application-specific data here; use 'getAppUserDataDirectory' -instead. +application-specific data here; use 'getXdgDirectory' or +'getAppUserDataDirectory' instead. On Unix, 'getHomeDirectory' returns the value of the @HOME@ environment variable. On Windows, the system is queried for a -suitable path; a typical path might be -@C:\/Documents And Settings\/user@. +suitable path; a typical path might be @C:\/Users\//\/@. The operation may fail with: @@ -1155,51 +1370,142 @@ cannot be found. -} getHomeDirectory :: IO FilePath -getHomeDirectory = - modifyIOError ((`ioeSetLocation` "getHomeDirectory")) $ do +getHomeDirectory = modifyIOError (`ioeSetLocation` "getHomeDirectory") get + where #if defined(mingw32_HOST_OS) - r <- E.try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_PROFILE nullPtr 0 - case (r :: Either IOException String) of - Right s -> return s - Left _ -> do - r1 <- E.try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_WINDOWS nullPtr 0 - case r1 of - Right s -> return s - Left e -> ioError (e :: IOException) + get = getFolderPath Win32.cSIDL_PROFILE `catchIOError` \ _ -> + getFolderPath Win32.cSIDL_WINDOWS + getFolderPath what = Win32.sHGetFolderPath nullPtr what nullPtr 0 #else - getEnv "HOME" + get = getEnv "HOME" #endif -{- | Returns the pathname of a directory in which application-specific -data for the current user can be stored. The result of -'getAppUserDataDirectory' for a given application is specific to -the current user. - -The argument should be the name of the application, which will be used -to construct the pathname (so avoid using unusual characters that -might result in an invalid pathname). - -Note: the directory may not actually exist, and may need to be created -first. It is expected that the parent directory exists and is -writable. - -On Unix, this function returns @$HOME\/.appName@. On Windows, a -typical path might be +-- | Special directories for storing user-specific application data, +-- configuration, and cache files, as specified by the +-- . +-- +-- Note: On Windows, 'XdgData' and 'XdgConfig' map to the same directory. +-- +-- @since 1.2.3.0 +data XdgDirectory + = XdgData + -- ^ For data files (e.g. images). + -- Defaults to @~\/.local\/share@ and can be + -- overridden by the @XDG_DATA_HOME@ environment variable. + -- On Windows, it is @%APPDATA%@ + -- (e.g. @C:\/Users\//\/\/AppData\/Roaming@). + -- Can be considered as the user-specific equivalent of @\/usr\/share@. + | XdgConfig + -- ^ For configuration files. + -- Defaults to @~\/.config@ and can be + -- overridden by the @XDG_CONFIG_HOME@ environment variable. + -- On Windows, it is @%APPDATA%@ + -- (e.g. @C:\/Users\//\/\/AppData\/Roaming@). + -- Can be considered as the user-specific equivalent of @\/etc@. + | XdgCache + -- ^ For non-essential files (e.g. cache). + -- Defaults to @~\/.cache@ and can be + -- overridden by the @XDG_CACHE_HOME@ environment variable. + -- On Windows, it is @%LOCALAPPDATA%@ + -- (e.g. @C:\/Users\//\/\/AppData\/Local@). + -- Can be considered as the user-specific equivalent of @\/var\/cache@. + deriving (Bounded, Enum, Eq, Ord, Read, Show) -> C:/Users/user/AppData/Roaming/appName +-- | Obtain the paths to special directories for storing user-specific +-- application data, configuration, and cache files, conforming to the +-- . +-- Compared with 'getAppUserDataDirectory', this function provides a more +-- fine-grained hierarchy as well as greater flexibility for the user. +-- +-- It also works on Windows, although in that case 'XdgData' and 'XdgConfig' +-- will map to the same directory. +-- +-- The second argument is usually the name of the application. Since it +-- will be integrated into the path, it must consist of valid path +-- characters. +-- +-- Note: The directory may not actually exist, in which case you would need +-- to create it with file mode @700@ (i.e. only accessible by the owner). +-- +-- @since 1.2.3.0 +getXdgDirectory :: XdgDirectory -- ^ which special directory + -> FilePath -- ^ a relative path that is appended + -- to the path; if empty, the base + -- path is returned + -> IO FilePath +getXdgDirectory xdgDir suffix = + modifyIOError (`ioeSetLocation` "getXdgDirectory") $ + normalise . ( suffix) <$> + case xdgDir of + XdgData -> get False "XDG_DATA_HOME" ".local/share" + XdgConfig -> get False "XDG_CONFIG_HOME" ".config" + XdgCache -> get True "XDG_CACHE_HOME" ".cache" + where +#if defined(mingw32_HOST_OS) + get isLocal _ _ = Win32.sHGetFolderPath nullPtr which nullPtr 0 + where which | isLocal = win32_cSIDL_LOCAL_APPDATA + | otherwise = Win32.cSIDL_APPDATA +#else + get _ name fallback = do + env <- lookupEnv name + case env of + Nothing -> fallback' + Just path | isRelative path -> fallback' + | otherwise -> return path + where fallback' = ( fallback) <$> getHomeDirectory -The operation may fail with: +-- | Return the value of an environment variable, or 'Nothing' if there is no +-- such value. (Equivalent to "lookupEnv" from base-4.6.) +lookupEnv :: String -> IO (Maybe String) +lookupEnv name = do + env <- tryIOErrorType isDoesNotExistError (getEnv name) + case env of + Left _ -> return Nothing + Right value -> return (Just value) -* 'UnsupportedOperation' -The operating system has no notion of application-specific data directory. +-- | Similar to 'try' but only catches a specify kind of 'IOError' as +-- specified by the predicate. +tryIOErrorType :: (IOError -> Bool) -> IO a -> IO (Either IOError a) +tryIOErrorType check action = do + result <- tryIOError action + case result of + Left err -> if check err then return (Left err) else ioError err + Right val -> return (Right val) +#endif -* 'isDoesNotExistError' -The home directory for the current user does not exist, or -cannot be found. --} -getAppUserDataDirectory :: String -> IO FilePath +-- | Obtain the path to a special directory for storing user-specific +-- application data (traditional Unix location). Except for backward +-- compatibility reasons, newer applications may prefer the the +-- XDG-conformant location provided by 'getXdgDirectory', which offers a +-- more fine-grained hierarchy as well as greater flexibility for the user +-- (). +-- +-- The argument is usually the name of the application. Since it will be +-- integrated into the path, it must consist of valid path characters. +-- +-- * On Unix-like systems, the path is @~\/./\/@. +-- * On Windows, the path is @%APPDATA%\//\/@ +-- (e.g. @C:\/Users\//\/\/AppData\/Roaming\//\/@) +-- +-- Note: the directory may not actually exist, in which case you would need +-- to create it. It is expected that the parent directory exists and is +-- writable. +-- +-- The operation may fail with: +-- +-- * 'UnsupportedOperation' +-- The operating system has no notion of application-specific data +-- directory. +-- +-- * 'isDoesNotExistError' +-- The home directory for the current user does not exist, or cannot be +-- found. +-- +getAppUserDataDirectory :: FilePath -- ^ a relative path that is appended + -- to the path + -> IO FilePath getAppUserDataDirectory appName = do - modifyIOError ((`ioeSetLocation` "getAppUserDataDirectory")) $ do + modifyIOError (`ioeSetLocation` "getAppUserDataDirectory") $ do #if defined(mingw32_HOST_OS) s <- Win32.sHGetFolderPath nullPtr Win32.cSIDL_APPDATA nullPtr 0 return (s++'\\':appName) @@ -1212,13 +1518,12 @@ The directory returned is expected to be writable by the current user, but note that it isn't generally considered good practice to store -application-specific data here; use 'getAppUserDataDirectory' -instead. +application-specific data here; use 'getXdgDirectory' or +'getAppUserDataDirectory' instead. On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@ environment variable. On Windows, the system is queried for a -suitable path; a typical path might be -@C:\/Documents And Settings\/user\/My Documents@. +suitable path; a typical path might be @C:\/Users\//\/\/Documents@. The operation may fail with: @@ -1231,7 +1536,7 @@ -} getUserDocumentsDirectory :: IO FilePath getUserDocumentsDirectory = do - modifyIOError ((`ioeSetLocation` "getUserDocumentsDirectory")) $ do + modifyIOError (`ioeSetLocation` "getUserDocumentsDirectory") $ do #if defined(mingw32_HOST_OS) Win32.sHGetFolderPath nullPtr Win32.cSIDL_PERSONAL nullPtr 0 #else @@ -1265,21 +1570,10 @@ The function doesn\'t verify whether the path exists. -} getTemporaryDirectory :: IO FilePath -getTemporaryDirectory = do +getTemporaryDirectory = #if defined(mingw32_HOST_OS) Win32.getTemporaryDirectory #else - getEnv "TMPDIR" - `catchIOError` \e -> if isDoesNotExistError e then return "/tmp" - else throwIO e -#endif - --- ToDo: This should be determined via autoconf (AC_EXEEXT) --- | Extension for executable files --- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2) -exeExtension :: String -#ifdef mingw32_HOST_OS -exeExtension = "exe" -#else -exeExtension = "" + getEnv "TMPDIR" `catchIOError` \ err -> + if isDoesNotExistError err then return "/tmp" else ioError err #endif diff --git a/System/Directory/Internal.hsc b/System/Directory/Internal.hsc new file mode 100644 --- /dev/null +++ b/System/Directory/Internal.hsc @@ -0,0 +1,31 @@ +#include + +module System.Directory.Internal + ( module System.Directory.Internal + +#ifdef HAVE_UTIMENSAT + , module System.Directory.Internal.C_utimensat +#endif + +#ifdef mingw32_HOST_OS + , module System.Directory.Internal.Windows +#else + , module System.Directory.Internal.Posix +#endif + +) where + +#ifdef HAVE_UTIMENSAT +import System.Directory.Internal.C_utimensat +#endif + +#ifdef mingw32_HOST_OS +import System.Directory.Internal.Windows +#else +import System.Directory.Internal.Posix +#endif + +-- | Filename extension for executable files (including the dot if any) +-- (usually @\"\"@ on POSIX systems and @\".exe\"@ on Windows or OS\/2). +exeExtension :: String +exeExtension = (#const_str EXE_EXTENSION) diff --git a/System/Directory/Internal/C_utimensat.hsc b/System/Directory/Internal/C_utimensat.hsc new file mode 100644 --- /dev/null +++ b/System/Directory/Internal/C_utimensat.hsc @@ -0,0 +1,48 @@ +#include + +#ifdef HAVE_FCNTL_H +# include +#endif +#ifdef HAVE_TIME_H +# include +#endif +#ifdef HAVE_SYS_STAT_H +# include +#endif + +module System.Directory.Internal.C_utimensat where +#ifdef HAVE_UTIMENSAT +import Foreign +import Foreign.C +import Data.Time.Clock.POSIX (POSIXTime) +import System.Posix.Types + +data CTimeSpec = CTimeSpec EpochTime CLong + +instance Storable CTimeSpec where + sizeOf _ = #size struct timespec + alignment _ = alignment (undefined :: CInt) + poke p (CTimeSpec sec nsec) = do + (#poke struct timespec, tv_sec ) p sec + (#poke struct timespec, tv_nsec) p nsec + peek p = do + sec <- #{peek struct timespec, tv_sec } p + nsec <- #{peek struct timespec, tv_nsec} p + return (CTimeSpec sec nsec) + +c_AT_FDCWD :: Integral a => a +c_AT_FDCWD = (#const AT_FDCWD) + +utimeOmit :: CTimeSpec +utimeOmit = CTimeSpec (CTime 0) (#const UTIME_OMIT) + +toCTimeSpec :: POSIXTime -> CTimeSpec +toCTimeSpec t = CTimeSpec (CTime sec) (truncate $ 10 ^ (9 :: Int) * frac) + where + (sec, frac) = if frac' < 0 then (sec' - 1, frac' + 1) else (sec', frac') + (sec', frac') = properFraction (toRational t) + +foreign import ccall unsafe "utimensat" c_utimensat + :: CInt -> CString -> Ptr CTimeSpec -> CInt -> IO CInt + +#endif diff --git a/System/Directory/Internal/Posix.hsc b/System/Directory/Internal/Posix.hsc new file mode 100644 --- /dev/null +++ b/System/Directory/Internal/Posix.hsc @@ -0,0 +1,42 @@ +#include + +#ifdef HAVE_LIMITS_H +# include +#endif + +module System.Directory.Internal.Posix where +#ifndef mingw32_HOST_OS +import Control.Monad ((>=>)) +import Control.Exception (bracket) +import Foreign +import Foreign.C + +-- we use the 'free' from the standard library here since it's not entirely +-- clear whether Haskell's 'free' corresponds to the same one +foreign import ccall unsafe "free" c_free :: Ptr a -> IO () + +c_PATH_MAX :: Maybe Int +#ifdef PATH_MAX +c_PATH_MAX | c_PATH_MAX' > toInteger maxValue = Nothing + | otherwise = Just (fromInteger c_PATH_MAX') + where c_PATH_MAX' = (#const PATH_MAX) + maxValue = maxBound `asTypeOf` case c_PATH_MAX of ~(Just x) -> x +#else +c_PATH_MAX = Nothing +#endif + +foreign import ccall unsafe "realpath" c_realpath + :: CString -> CString -> IO CString + +withRealpath :: CString -> (CString -> IO a) -> IO a +withRealpath path action = case c_PATH_MAX of + Nothing -> + -- newer versions of POSIX support cases where the 2nd arg is NULL; + -- hopefully that is the case here, as there is no safer way + bracket (realpath nullPtr) c_free action + Just pathMax -> + -- allocate one extra just to be safe + allocaBytes (pathMax + 1) (realpath >=> action) + where realpath = throwErrnoIfNull "" . c_realpath path + +#endif diff --git a/System/Directory/Internal/Windows.hsc b/System/Directory/Internal/Windows.hsc new file mode 100644 --- /dev/null +++ b/System/Directory/Internal/Windows.hsc @@ -0,0 +1,23 @@ +#include + +#ifdef HAVE_SYS_STAT_H +# include +#endif + +module System.Directory.Internal.Windows where +#ifdef mingw32_HOST_OS +import System.Posix.Types + +s_IRUSR :: CMode +s_IRUSR = (#const S_IRUSR) + +s_IWUSR :: CMode +s_IWUSR = (#const S_IWUSR) + +s_IXUSR :: CMode +s_IXUSR = (#const S_IXUSR) + +s_IFDIR :: CMode +s_IFDIR = (#const S_IFDIR) + +#endif diff --git a/cbits/directory.c b/cbits/directory.c --- a/cbits/directory.c +++ b/cbits/directory.c @@ -4,6 +4,8 @@ * */ +/* [DEPRECATED] This file may be removed in future versions. */ + #define INLINE #include "HsDirectory.h" diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,10 +1,32 @@ Changelog for the [`directory`][1] package ========================================== +## 1.2.3.0 (July 2015) + + * Add support for XDG Base Directory Specification + ([#6](https://github.com/haskell/directory/issues/6)) + + * Implement `setModificationTime` counterpart to `getModificationTime` + ([#13](https://github.com/haskell/directory/issues/13)) + + * Implement `getAccessTime` and `setAccessTime` + + * Fix `canonicalizePath` so that it always returns a reasonable result even + if the path is inaccessible and will not throw exceptions unless the + current directory cannot be obtained + ([#23](https://github.com/haskell/directory/issues/23)) + + * Corrected the trailing slash behavior of `makeAbsolute` + so that `makeAbsolute "" == makeAbsolute "."` + + * Deprecate use of `HsDirectory.h` and `HsDirectoryConfig.h` + + * Implement `withCurrentDirectory` + ## 1.2.2.1 (Apr 2015) - * [#24](https://github.com/haskell/directory/issues/24): - Fix dependency problem on NixOS when building with tests + * Fix dependency problem on NixOS when building with tests + ([#24](https://github.com/haskell/directory/issues/24)) ## 1.2.2.0 (Mar 2015) @@ -16,23 +38,23 @@ * Replace `throw` by better defined `throwIO`s - * [#17](https://github.com/haskell/directory/pull/17): - Avoid stack overflow in `getDirectoryContents` + * Avoid stack overflow in `getDirectoryContents` + ([#17](https://github.com/haskell/directory/pull/17)) - * [#14](https://github.com/haskell/directory/issues/14): - Expose `findExecutables` + * Expose `findExecutables` + ([#14](https://github.com/haskell/directory/issues/14)) - * [#15](https://github.com/haskell/directory/issues/15): - `removeDirectoryRecursive` no longer follows symlinks under any + * `removeDirectoryRecursive` no longer follows symlinks under any circumstances + ([#15](https://github.com/haskell/directory/issues/15)) - * [#9](https://github.com/haskell/directory/issues/9): - Allow trailing path separators in `getPermissions` on Windows + * Allow trailing path separators in `getPermissions` on Windows + ([#9](https://github.com/haskell/directory/issues/9)) - * [#8](https://github.com/haskell/directory/pull/8): - `renameFile` now always throws the correct error type + * `renameFile` now always throws the correct error type (`InappropriateType`) when the destination is a directory, as long as the filesystem is not being modified concurrently + ([#8](https://github.com/haskell/directory/pull/8)) * Add `makeAbsolute`, which should be preferred over `canonicalizePath` unless one requires symbolic links to be resolved diff --git a/config.guess b/config.guess deleted file mode 100644 --- a/config.guess +++ /dev/null @@ -1,1420 +0,0 @@ -#! /bin/sh -# Attempt to guess a canonical system name. -# Copyright 1992-2014 Free Software Foundation, Inc. - -timestamp='2014-03-23' - -# This file is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, see . -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that -# program. This Exception is an additional permission under section 7 -# of the GNU General Public License, version 3 ("GPLv3"). -# -# Originally written by Per Bothner. -# -# You can get the latest version of this script from: -# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD -# -# Please send patches with a ChangeLog entry to config-patches@gnu.org. - - -me=`echo "$0" | sed -e 's,.*/,,'` - -usage="\ -Usage: $0 [OPTION] - -Output the configuration name of the system \`$me' is run on. - -Operation modes: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit - -Report bugs and patches to ." - -version="\ -GNU config.guess ($timestamp) - -Originally written by Per Bothner. -Copyright 1992-2014 Free Software Foundation, Inc. - -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -help=" -Try \`$me --help' for more information." - -# Parse command line -while test $# -gt 0 ; do - case $1 in - --time-stamp | --time* | -t ) - echo "$timestamp" ; exit ;; - --version | -v ) - echo "$version" ; exit ;; - --help | --h* | -h ) - echo "$usage"; exit ;; - -- ) # Stop option processing - shift; break ;; - - ) # Use stdin as input. - break ;; - -* ) - echo "$me: invalid option $1$help" >&2 - exit 1 ;; - * ) - break ;; - esac -done - -if test $# != 0; then - echo "$me: too many arguments$help" >&2 - exit 1 -fi - -trap 'exit 1' 1 2 15 - -# CC_FOR_BUILD -- compiler used by this script. Note that the use of a -# compiler to aid in system detection is discouraged as it requires -# temporary files to be created and, as you can see below, it is a -# headache to deal with in a portable fashion. - -# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still -# use `HOST_CC' if defined, but it is deprecated. - -# Portable tmp directory creation inspired by the Autoconf team. - -set_cc_for_build=' -trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; -trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; -: ${TMPDIR=/tmp} ; - { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || - { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || - { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || - { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; -dummy=$tmp/dummy ; -tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; -case $CC_FOR_BUILD,$HOST_CC,$CC in - ,,) echo "int x;" > $dummy.c ; - for c in cc gcc c89 c99 ; do - if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then - CC_FOR_BUILD="$c"; break ; - fi ; - done ; - if test x"$CC_FOR_BUILD" = x ; then - CC_FOR_BUILD=no_compiler_found ; - fi - ;; - ,,*) CC_FOR_BUILD=$CC ;; - ,*,*) CC_FOR_BUILD=$HOST_CC ;; -esac ; set_cc_for_build= ;' - -# This is needed to find uname on a Pyramid OSx when run in the BSD universe. -# (ghazi@noc.rutgers.edu 1994-08-24) -if (test -f /.attbin/uname) >/dev/null 2>&1 ; then - PATH=$PATH:/.attbin ; export PATH -fi - -UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown -UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown -UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown -UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown - -case "${UNAME_SYSTEM}" in -Linux|GNU|GNU/*) - # If the system lacks a compiler, then just pick glibc. - # We could probably try harder. - LIBC=gnu - - eval $set_cc_for_build - cat <<-EOF > $dummy.c - #include - #if defined(__UCLIBC__) - LIBC=uclibc - #elif defined(__dietlibc__) - LIBC=dietlibc - #else - LIBC=gnu - #endif - EOF - eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC' | sed 's, ,,g'` - ;; -esac - -# Note: order is significant - the case branches are not exclusive. - -case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in - *:NetBSD:*:*) - # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, - # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently - # switched to ELF, *-*-netbsd* would select the old - # object file format. This provides both forward - # compatibility and a consistent mechanism for selecting the - # object file format. - # - # Note: NetBSD doesn't particularly care about the vendor - # portion of the name. We always set it to "unknown". - sysctl="sysctl -n hw.machine_arch" - UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ - /usr/sbin/$sysctl 2>/dev/null || echo unknown)` - case "${UNAME_MACHINE_ARCH}" in - armeb) machine=armeb-unknown ;; - arm*) machine=arm-unknown ;; - sh3el) machine=shl-unknown ;; - sh3eb) machine=sh-unknown ;; - sh5el) machine=sh5le-unknown ;; - *) machine=${UNAME_MACHINE_ARCH}-unknown ;; - esac - # The Operating System including object format, if it has switched - # to ELF recently, or will in the future. - case "${UNAME_MACHINE_ARCH}" in - arm*|i386|m68k|ns32k|sh3*|sparc|vax) - eval $set_cc_for_build - if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ELF__ - then - # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). - # Return netbsd for either. FIX? - os=netbsd - else - os=netbsdelf - fi - ;; - *) - os=netbsd - ;; - esac - # The OS release - # Debian GNU/NetBSD machines have a different userland, and - # thus, need a distinct triplet. However, they do not need - # kernel version information, so it can be replaced with a - # suitable tag, in the style of linux-gnu. - case "${UNAME_VERSION}" in - Debian*) - release='-gnu' - ;; - *) - release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` - ;; - esac - # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: - # contains redundant information, the shorter form: - # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. - echo "${machine}-${os}${release}" - exit ;; - *:Bitrig:*:*) - UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` - echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} - exit ;; - *:OpenBSD:*:*) - UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` - echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} - exit ;; - *:ekkoBSD:*:*) - echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} - exit ;; - *:SolidBSD:*:*) - echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} - exit ;; - macppc:MirBSD:*:*) - echo powerpc-unknown-mirbsd${UNAME_RELEASE} - exit ;; - *:MirBSD:*:*) - echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} - exit ;; - alpha:OSF1:*:*) - case $UNAME_RELEASE in - *4.0) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` - ;; - *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` - ;; - esac - # According to Compaq, /usr/sbin/psrinfo has been available on - # OSF/1 and Tru64 systems produced since 1995. I hope that - # covers most systems running today. This code pipes the CPU - # types through head -n 1, so we only detect the type of CPU 0. - ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` - case "$ALPHA_CPU_TYPE" in - "EV4 (21064)") - UNAME_MACHINE="alpha" ;; - "EV4.5 (21064)") - UNAME_MACHINE="alpha" ;; - "LCA4 (21066/21068)") - UNAME_MACHINE="alpha" ;; - "EV5 (21164)") - UNAME_MACHINE="alphaev5" ;; - "EV5.6 (21164A)") - UNAME_MACHINE="alphaev56" ;; - "EV5.6 (21164PC)") - UNAME_MACHINE="alphapca56" ;; - "EV5.7 (21164PC)") - UNAME_MACHINE="alphapca57" ;; - "EV6 (21264)") - UNAME_MACHINE="alphaev6" ;; - "EV6.7 (21264A)") - UNAME_MACHINE="alphaev67" ;; - "EV6.8CB (21264C)") - UNAME_MACHINE="alphaev68" ;; - "EV6.8AL (21264B)") - UNAME_MACHINE="alphaev68" ;; - "EV6.8CX (21264D)") - UNAME_MACHINE="alphaev68" ;; - "EV6.9A (21264/EV69A)") - UNAME_MACHINE="alphaev69" ;; - "EV7 (21364)") - UNAME_MACHINE="alphaev7" ;; - "EV7.9 (21364A)") - UNAME_MACHINE="alphaev79" ;; - esac - # A Pn.n version is a patched version. - # A Vn.n version is a released version. - # A Tn.n version is a released field test version. - # A Xn.n version is an unreleased experimental baselevel. - # 1.2 uses "1.2" for uname -r. - echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - # Reset EXIT trap before exiting to avoid spurious non-zero exit code. - exitcode=$? - trap '' 0 - exit $exitcode ;; - Alpha\ *:Windows_NT*:*) - # How do we know it's Interix rather than the generic POSIX subsystem? - # Should we change UNAME_MACHINE based on the output of uname instead - # of the specific Alpha model? - echo alpha-pc-interix - exit ;; - 21064:Windows_NT:50:3) - echo alpha-dec-winnt3.5 - exit ;; - Amiga*:UNIX_System_V:4.0:*) - echo m68k-unknown-sysv4 - exit ;; - *:[Aa]miga[Oo][Ss]:*:*) - echo ${UNAME_MACHINE}-unknown-amigaos - exit ;; - *:[Mm]orph[Oo][Ss]:*:*) - echo ${UNAME_MACHINE}-unknown-morphos - exit ;; - *:OS/390:*:*) - echo i370-ibm-openedition - exit ;; - *:z/VM:*:*) - echo s390-ibm-zvmoe - exit ;; - *:OS400:*:*) - echo powerpc-ibm-os400 - exit ;; - arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) - echo arm-acorn-riscix${UNAME_RELEASE} - exit ;; - arm*:riscos:*:*|arm*:RISCOS:*:*) - echo arm-unknown-riscos - exit ;; - SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) - echo hppa1.1-hitachi-hiuxmpp - exit ;; - Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) - # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. - if test "`(/bin/universe) 2>/dev/null`" = att ; then - echo pyramid-pyramid-sysv3 - else - echo pyramid-pyramid-bsd - fi - exit ;; - NILE*:*:*:dcosx) - echo pyramid-pyramid-svr4 - exit ;; - DRS?6000:unix:4.0:6*) - echo sparc-icl-nx6 - exit ;; - DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) - case `/usr/bin/uname -p` in - sparc) echo sparc-icl-nx7; exit ;; - esac ;; - s390x:SunOS:*:*) - echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - sun4H:SunOS:5.*:*) - echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) - echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) - echo i386-pc-auroraux${UNAME_RELEASE} - exit ;; - i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) - eval $set_cc_for_build - SUN_ARCH="i386" - # If there is a compiler, see if it is configured for 64-bit objects. - # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. - # This test works for both compilers. - if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then - if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ - (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_64BIT_ARCH >/dev/null - then - SUN_ARCH="x86_64" - fi - fi - echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - sun4*:SunOS:6*:*) - # According to config.sub, this is the proper way to canonicalize - # SunOS6. Hard to guess exactly what SunOS6 will be like, but - # it's likely to be more like Solaris than SunOS4. - echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - sun4*:SunOS:*:*) - case "`/usr/bin/arch -k`" in - Series*|S4*) - UNAME_RELEASE=`uname -v` - ;; - esac - # Japanese Language versions have a version number like `4.1.3-JL'. - echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` - exit ;; - sun3*:SunOS:*:*) - echo m68k-sun-sunos${UNAME_RELEASE} - exit ;; - sun*:*:4.2BSD:*) - UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` - test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 - case "`/bin/arch`" in - sun3) - echo m68k-sun-sunos${UNAME_RELEASE} - ;; - sun4) - echo sparc-sun-sunos${UNAME_RELEASE} - ;; - esac - exit ;; - aushp:SunOS:*:*) - echo sparc-auspex-sunos${UNAME_RELEASE} - exit ;; - # The situation for MiNT is a little confusing. The machine name - # can be virtually everything (everything which is not - # "atarist" or "atariste" at least should have a processor - # > m68000). The system name ranges from "MiNT" over "FreeMiNT" - # to the lowercase version "mint" (or "freemint"). Finally - # the system name "TOS" denotes a system which is actually not - # MiNT. But MiNT is downward compatible to TOS, so this should - # be no problem. - atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit ;; - atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit ;; - *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit ;; - milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; - hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; - *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; - m68k:machten:*:*) - echo m68k-apple-machten${UNAME_RELEASE} - exit ;; - powerpc:machten:*:*) - echo powerpc-apple-machten${UNAME_RELEASE} - exit ;; - RISC*:Mach:*:*) - echo mips-dec-mach_bsd4.3 - exit ;; - RISC*:ULTRIX:*:*) - echo mips-dec-ultrix${UNAME_RELEASE} - exit ;; - VAX*:ULTRIX*:*:*) - echo vax-dec-ultrix${UNAME_RELEASE} - exit ;; - 2020:CLIX:*:* | 2430:CLIX:*:*) - echo clipper-intergraph-clix${UNAME_RELEASE} - exit ;; - mips:*:*:UMIPS | mips:*:*:RISCos) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c -#ifdef __cplusplus -#include /* for printf() prototype */ - int main (int argc, char *argv[]) { -#else - int main (argc, argv) int argc; char *argv[]; { -#endif - #if defined (host_mips) && defined (MIPSEB) - #if defined (SYSTYPE_SYSV) - printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_SVR4) - printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) - printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); - #endif - #endif - exit (-1); - } -EOF - $CC_FOR_BUILD -o $dummy $dummy.c && - dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && - SYSTEM_NAME=`$dummy $dummyarg` && - { echo "$SYSTEM_NAME"; exit; } - echo mips-mips-riscos${UNAME_RELEASE} - exit ;; - Motorola:PowerMAX_OS:*:*) - echo powerpc-motorola-powermax - exit ;; - Motorola:*:4.3:PL8-*) - echo powerpc-harris-powermax - exit ;; - Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) - echo powerpc-harris-powermax - exit ;; - Night_Hawk:Power_UNIX:*:*) - echo powerpc-harris-powerunix - exit ;; - m88k:CX/UX:7*:*) - echo m88k-harris-cxux7 - exit ;; - m88k:*:4*:R4*) - echo m88k-motorola-sysv4 - exit ;; - m88k:*:3*:R3*) - echo m88k-motorola-sysv3 - exit ;; - AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` - if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] - then - if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ - [ ${TARGET_BINARY_INTERFACE}x = x ] - then - echo m88k-dg-dgux${UNAME_RELEASE} - else - echo m88k-dg-dguxbcs${UNAME_RELEASE} - fi - else - echo i586-dg-dgux${UNAME_RELEASE} - fi - exit ;; - M88*:DolphinOS:*:*) # DolphinOS (SVR3) - echo m88k-dolphin-sysv3 - exit ;; - M88*:*:R3*:*) - # Delta 88k system running SVR3 - echo m88k-motorola-sysv3 - exit ;; - XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) - echo m88k-tektronix-sysv3 - exit ;; - Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) - echo m68k-tektronix-bsd - exit ;; - *:IRIX*:*:*) - echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` - exit ;; - ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. - echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id - exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' - i*86:AIX:*:*) - echo i386-ibm-aix - exit ;; - ia64:AIX:*:*) - if [ -x /usr/bin/oslevel ] ; then - IBM_REV=`/usr/bin/oslevel` - else - IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} - fi - echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} - exit ;; - *:AIX:2:3) - if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include - - main() - { - if (!__power_pc()) - exit(1); - puts("powerpc-ibm-aix3.2.5"); - exit(0); - } -EOF - if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` - then - echo "$SYSTEM_NAME" - else - echo rs6000-ibm-aix3.2.5 - fi - elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then - echo rs6000-ibm-aix3.2.4 - else - echo rs6000-ibm-aix3.2 - fi - exit ;; - *:AIX:*:[4567]) - IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` - if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then - IBM_ARCH=rs6000 - else - IBM_ARCH=powerpc - fi - if [ -x /usr/bin/oslevel ] ; then - IBM_REV=`/usr/bin/oslevel` - else - IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} - fi - echo ${IBM_ARCH}-ibm-aix${IBM_REV} - exit ;; - *:AIX:*:*) - echo rs6000-ibm-aix - exit ;; - ibmrt:4.4BSD:*|romp-ibm:BSD:*) - echo romp-ibm-bsd4.4 - exit ;; - ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and - echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to - exit ;; # report: romp-ibm BSD 4.3 - *:BOSX:*:*) - echo rs6000-bull-bosx - exit ;; - DPX/2?00:B.O.S.:*:*) - echo m68k-bull-sysv3 - exit ;; - 9000/[34]??:4.3bsd:1.*:*) - echo m68k-hp-bsd - exit ;; - hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) - echo m68k-hp-bsd4.4 - exit ;; - 9000/[34678]??:HP-UX:*:*) - HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` - case "${UNAME_MACHINE}" in - 9000/31? ) HP_ARCH=m68000 ;; - 9000/[34]?? ) HP_ARCH=m68k ;; - 9000/[678][0-9][0-9]) - if [ -x /usr/bin/getconf ]; then - sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; - '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac - fi - if [ "${HP_ARCH}" = "" ]; then - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - - #define _HPUX_SOURCE - #include - #include - - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); - - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } -EOF - (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` - test -z "$HP_ARCH" && HP_ARCH=hppa - fi ;; - esac - if [ ${HP_ARCH} = "hppa2.0w" ] - then - eval $set_cc_for_build - - # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating - # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler - # generating 64-bit code. GNU and HP use different nomenclature: - # - # $ CC_FOR_BUILD=cc ./config.guess - # => hppa2.0w-hp-hpux11.23 - # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess - # => hppa64-hp-hpux11.23 - - if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep -q __LP64__ - then - HP_ARCH="hppa2.0w" - else - HP_ARCH="hppa64" - fi - fi - echo ${HP_ARCH}-hp-hpux${HPUX_REV} - exit ;; - ia64:HP-UX:*:*) - HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` - echo ia64-hp-hpux${HPUX_REV} - exit ;; - 3050*:HI-UX:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include - int - main () - { - long cpu = sysconf (_SC_CPU_VERSION); - /* The order matters, because CPU_IS_HP_MC68K erroneously returns - true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct - results, however. */ - if (CPU_IS_PA_RISC (cpu)) - { - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; - case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; - default: puts ("hppa-hitachi-hiuxwe2"); break; - } - } - else if (CPU_IS_HP_MC68K (cpu)) - puts ("m68k-hitachi-hiuxwe2"); - else puts ("unknown-hitachi-hiuxwe2"); - exit (0); - } -EOF - $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && - { echo "$SYSTEM_NAME"; exit; } - echo unknown-hitachi-hiuxwe2 - exit ;; - 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) - echo hppa1.1-hp-bsd - exit ;; - 9000/8??:4.3bsd:*:*) - echo hppa1.0-hp-bsd - exit ;; - *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) - echo hppa1.0-hp-mpeix - exit ;; - hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) - echo hppa1.1-hp-osf - exit ;; - hp8??:OSF1:*:*) - echo hppa1.0-hp-osf - exit ;; - i*86:OSF1:*:*) - if [ -x /usr/sbin/sysversion ] ; then - echo ${UNAME_MACHINE}-unknown-osf1mk - else - echo ${UNAME_MACHINE}-unknown-osf1 - fi - exit ;; - parisc*:Lites*:*:*) - echo hppa1.1-hp-lites - exit ;; - C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) - echo c1-convex-bsd - exit ;; - C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit ;; - C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) - echo c34-convex-bsd - exit ;; - C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) - echo c38-convex-bsd - exit ;; - C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) - echo c4-convex-bsd - exit ;; - CRAY*Y-MP:*:*:*) - echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*[A-Z]90:*:*:*) - echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ - | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ - -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ - -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*TS:*:*:*) - echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*T3E:*:*:*) - echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*SV1:*:*:*) - echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - *:UNICOS/mp:*:*) - echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) - FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; - 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; - i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) - echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} - exit ;; - sparc*:BSD/OS:*:*) - echo sparc-unknown-bsdi${UNAME_RELEASE} - exit ;; - *:BSD/OS:*:*) - echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} - exit ;; - *:FreeBSD:*:*) - UNAME_PROCESSOR=`/usr/bin/uname -p` - case ${UNAME_PROCESSOR} in - amd64) - echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; - *) - echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; - esac - exit ;; - i*:CYGWIN*:*) - echo ${UNAME_MACHINE}-pc-cygwin - exit ;; - *:MINGW64*:*) - echo ${UNAME_MACHINE}-pc-mingw64 - exit ;; - *:MINGW*:*) - echo ${UNAME_MACHINE}-pc-mingw32 - exit ;; - *:MSYS*:*) - echo ${UNAME_MACHINE}-pc-msys - exit ;; - i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 - exit ;; - i*:PW*:*) - echo ${UNAME_MACHINE}-pc-pw32 - exit ;; - *:Interix*:*) - case ${UNAME_MACHINE} in - x86) - echo i586-pc-interix${UNAME_RELEASE} - exit ;; - authenticamd | genuineintel | EM64T) - echo x86_64-unknown-interix${UNAME_RELEASE} - exit ;; - IA64) - echo ia64-unknown-interix${UNAME_RELEASE} - exit ;; - esac ;; - [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) - echo i${UNAME_MACHINE}-pc-mks - exit ;; - 8664:Windows_NT:*) - echo x86_64-pc-mks - exit ;; - i*:Windows_NT*:* | Pentium*:Windows_NT*:*) - # How do we know it's Interix rather than the generic POSIX subsystem? - # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we - # UNAME_MACHINE based on the output of uname instead of i386? - echo i586-pc-interix - exit ;; - i*:UWIN*:*) - echo ${UNAME_MACHINE}-pc-uwin - exit ;; - amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) - echo x86_64-unknown-cygwin - exit ;; - p*:CYGWIN*:*) - echo powerpcle-unknown-cygwin - exit ;; - prep*:SunOS:5.*:*) - echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - *:GNU:*:*) - # the GNU system - echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-${LIBC}`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` - exit ;; - *:GNU/*:*:*) - # other systems with GNU libc and userland - echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-${LIBC} - exit ;; - i*86:Minix:*:*) - echo ${UNAME_MACHINE}-pc-minix - exit ;; - aarch64:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - aarch64_be:Linux:*:*) - UNAME_MACHINE=aarch64_be - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep -q ld.so.1 - if test "$?" = 0 ; then LIBC="gnulibc1" ; fi - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - arc:Linux:*:* | arceb:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - arm*:Linux:*:*) - eval $set_cc_for_build - if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ARM_EABI__ - then - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - else - if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ARM_PCS_VFP - then - echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabi - else - echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabihf - fi - fi - exit ;; - avr32*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - cris:Linux:*:*) - echo ${UNAME_MACHINE}-axis-linux-${LIBC} - exit ;; - crisv32:Linux:*:*) - echo ${UNAME_MACHINE}-axis-linux-${LIBC} - exit ;; - frv:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - hexagon:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - i*86:Linux:*:*) - echo ${UNAME_MACHINE}-pc-linux-${LIBC} - exit ;; - ia64:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - m32r*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - m68*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - mips:Linux:*:* | mips64:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef ${UNAME_MACHINE} - #undef ${UNAME_MACHINE}el - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=${UNAME_MACHINE}el - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=${UNAME_MACHINE} - #else - CPU= - #endif - #endif -EOF - eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-${LIBC}"; exit; } - ;; - openrisc*:Linux:*:*) - echo or1k-unknown-linux-${LIBC} - exit ;; - or32:Linux:*:* | or1k*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - padre:Linux:*:*) - echo sparc-unknown-linux-${LIBC} - exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-${LIBC} - exit ;; - parisc:Linux:*:* | hppa:Linux:*:*) - # Look for CPU level - case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in - PA7*) echo hppa1.1-unknown-linux-${LIBC} ;; - PA8*) echo hppa2.0-unknown-linux-${LIBC} ;; - *) echo hppa-unknown-linux-${LIBC} ;; - esac - exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-${LIBC} - exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-${LIBC} - exit ;; - ppc64le:Linux:*:*) - echo powerpc64le-unknown-linux-${LIBC} - exit ;; - ppcle:Linux:*:*) - echo powerpcle-unknown-linux-${LIBC} - exit ;; - s390:Linux:*:* | s390x:Linux:*:*) - echo ${UNAME_MACHINE}-ibm-linux-${LIBC} - exit ;; - sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - sh*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - sparc:Linux:*:* | sparc64:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - tile*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - vax:Linux:*:*) - echo ${UNAME_MACHINE}-dec-linux-${LIBC} - exit ;; - x86_64:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - xtensa*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-${LIBC} - exit ;; - i*86:DYNIX/ptx:4*:*) - # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. - # earlier versions are messed up and put the nodename in both - # sysname and nodename. - echo i386-sequent-sysv4 - exit ;; - i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, - # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. - echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} - exit ;; - i*86:OS/2:*:*) - # If we were able to find `uname', then EMX Unix compatibility - # is probably installed. - echo ${UNAME_MACHINE}-pc-os2-emx - exit ;; - i*86:XTS-300:*:STOP) - echo ${UNAME_MACHINE}-unknown-stop - exit ;; - i*86:atheos:*:*) - echo ${UNAME_MACHINE}-unknown-atheos - exit ;; - i*86:syllable:*:*) - echo ${UNAME_MACHINE}-pc-syllable - exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) - echo i386-unknown-lynxos${UNAME_RELEASE} - exit ;; - i*86:*DOS:*:*) - echo ${UNAME_MACHINE}-pc-msdosdjgpp - exit ;; - i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) - UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` - if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then - echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} - else - echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} - fi - exit ;; - i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. - case `/bin/uname -X | grep "^Machine"` in - *486*) UNAME_MACHINE=i486 ;; - *Pentium) UNAME_MACHINE=i586 ;; - *Pent*|*Celeron) UNAME_MACHINE=i686 ;; - esac - echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} - exit ;; - i*86:*:3.2:*) - if test -f /usr/options/cb.name; then - UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then - UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` - (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 - (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ - && UNAME_MACHINE=i586 - (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ - && UNAME_MACHINE=i686 - (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ - && UNAME_MACHINE=i686 - echo ${UNAME_MACHINE}-pc-sco$UNAME_REL - else - echo ${UNAME_MACHINE}-pc-sysv32 - fi - exit ;; - pc:*:*:*) - # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i586. - # Note: whatever this is, it MUST be the same as what config.sub - # prints for the "djgpp" host, or else GDB configury will decide that - # this is a cross-build. - echo i586-pc-msdosdjgpp - exit ;; - Intel:Mach:3*:*) - echo i386-pc-mach3 - exit ;; - paragon:*:*:*) - echo i860-intel-osf1 - exit ;; - i860:*:4.*:*) # i860-SVR4 - if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then - echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 - else # Add other i860-SVR4 vendors below as they are discovered. - echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 - fi - exit ;; - mini*:CTIX:SYS*5:*) - # "miniframe" - echo m68010-convergent-sysv - exit ;; - mc68k:UNIX:SYSTEM5:3.51m) - echo m68k-convergent-sysv - exit ;; - M680?0:D-NIX:5.3:*) - echo m68k-diab-dnix - exit ;; - M68*:*:R3V[5678]*:*) - test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; - 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) - OS_REL='' - test -r /etc/.relid \ - && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4.3${OS_REL}; exit; } - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ - && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; - 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; - NCR*:*:4.2:* | MPRAS*:*:4.2:*) - OS_REL='.3' - test -r /etc/.relid \ - && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4.3${OS_REL}; exit; } - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ - && { echo i586-ncr-sysv4.3${OS_REL}; exit; } - /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ - && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; - m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) - echo m68k-unknown-lynxos${UNAME_RELEASE} - exit ;; - mc68030:UNIX_System_V:4.*:*) - echo m68k-atari-sysv4 - exit ;; - TSUNAMI:LynxOS:2.*:*) - echo sparc-unknown-lynxos${UNAME_RELEASE} - exit ;; - rs6000:LynxOS:2.*:*) - echo rs6000-unknown-lynxos${UNAME_RELEASE} - exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) - echo powerpc-unknown-lynxos${UNAME_RELEASE} - exit ;; - SM[BE]S:UNIX_SV:*:*) - echo mips-dde-sysv${UNAME_RELEASE} - exit ;; - RM*:ReliantUNIX-*:*:*) - echo mips-sni-sysv4 - exit ;; - RM*:SINIX-*:*:*) - echo mips-sni-sysv4 - exit ;; - *:SINIX-*:*:*) - if uname -p 2>/dev/null >/dev/null ; then - UNAME_MACHINE=`(uname -p) 2>/dev/null` - echo ${UNAME_MACHINE}-sni-sysv4 - else - echo ns32k-sni-sysv - fi - exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says - echo i586-unisys-sysv4 - exit ;; - *:UNIX_System_V:4*:FTX*) - # From Gerald Hewes . - # How about differentiating between stratus architectures? -djm - echo hppa1.1-stratus-sysv4 - exit ;; - *:*:*:FTX*) - # From seanf@swdc.stratus.com. - echo i860-stratus-sysv4 - exit ;; - i*86:VOS:*:*) - # From Paul.Green@stratus.com. - echo ${UNAME_MACHINE}-stratus-vos - exit ;; - *:VOS:*:*) - # From Paul.Green@stratus.com. - echo hppa1.1-stratus-vos - exit ;; - mc68*:A/UX:*:*) - echo m68k-apple-aux${UNAME_RELEASE} - exit ;; - news*:NEWS-OS:6*:*) - echo mips-sony-newsos6 - exit ;; - R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) - if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} - else - echo mips-unknown-sysv${UNAME_RELEASE} - fi - exit ;; - BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. - echo powerpc-be-beos - exit ;; - BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. - echo powerpc-apple-beos - exit ;; - BePC:BeOS:*:*) # BeOS running on Intel PC compatible. - echo i586-pc-beos - exit ;; - BePC:Haiku:*:*) # Haiku running on Intel PC compatible. - echo i586-pc-haiku - exit ;; - x86_64:Haiku:*:*) - echo x86_64-unknown-haiku - exit ;; - SX-4:SUPER-UX:*:*) - echo sx4-nec-superux${UNAME_RELEASE} - exit ;; - SX-5:SUPER-UX:*:*) - echo sx5-nec-superux${UNAME_RELEASE} - exit ;; - SX-6:SUPER-UX:*:*) - echo sx6-nec-superux${UNAME_RELEASE} - exit ;; - SX-7:SUPER-UX:*:*) - echo sx7-nec-superux${UNAME_RELEASE} - exit ;; - SX-8:SUPER-UX:*:*) - echo sx8-nec-superux${UNAME_RELEASE} - exit ;; - SX-8R:SUPER-UX:*:*) - echo sx8r-nec-superux${UNAME_RELEASE} - exit ;; - Power*:Rhapsody:*:*) - echo powerpc-apple-rhapsody${UNAME_RELEASE} - exit ;; - *:Rhapsody:*:*) - echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} - exit ;; - *:Darwin:*:*) - UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown - eval $set_cc_for_build - if test "$UNAME_PROCESSOR" = unknown ; then - UNAME_PROCESSOR=powerpc - fi - if test `echo "$UNAME_RELEASE" | sed -e 's/\..*//'` -le 10 ; then - if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then - if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ - (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_64BIT_ARCH >/dev/null - then - case $UNAME_PROCESSOR in - i386) UNAME_PROCESSOR=x86_64 ;; - powerpc) UNAME_PROCESSOR=powerpc64 ;; - esac - fi - fi - elif test "$UNAME_PROCESSOR" = i386 ; then - # Avoid executing cc on OS X 10.9, as it ships with a stub - # that puts up a graphical alert prompting to install - # developer tools. Any system running Mac OS X 10.7 or - # later (Darwin 11 and later) is required to have a 64-bit - # processor. This is not true of the ARM version of Darwin - # that Apple uses in portable devices. - UNAME_PROCESSOR=x86_64 - fi - echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} - exit ;; - *:procnto*:*:* | *:QNX:[0123456789]*:*) - UNAME_PROCESSOR=`uname -p` - if test "$UNAME_PROCESSOR" = "x86"; then - UNAME_PROCESSOR=i386 - UNAME_MACHINE=pc - fi - echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} - exit ;; - *:QNX:*:4*) - echo i386-pc-qnx - exit ;; - NEO-?:NONSTOP_KERNEL:*:*) - echo neo-tandem-nsk${UNAME_RELEASE} - exit ;; - NSE-*:NONSTOP_KERNEL:*:*) - echo nse-tandem-nsk${UNAME_RELEASE} - exit ;; - NSR-?:NONSTOP_KERNEL:*:*) - echo nsr-tandem-nsk${UNAME_RELEASE} - exit ;; - *:NonStop-UX:*:*) - echo mips-compaq-nonstopux - exit ;; - BS2000:POSIX*:*:*) - echo bs2000-siemens-sysv - exit ;; - DS/*:UNIX_System_V:*:*) - echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} - exit ;; - *:Plan9:*:*) - # "uname -m" is not consistent, so use $cputype instead. 386 - # is converted to i386 for consistency with other x86 - # operating systems. - if test "$cputype" = "386"; then - UNAME_MACHINE=i386 - else - UNAME_MACHINE="$cputype" - fi - echo ${UNAME_MACHINE}-unknown-plan9 - exit ;; - *:TOPS-10:*:*) - echo pdp10-unknown-tops10 - exit ;; - *:TENEX:*:*) - echo pdp10-unknown-tenex - exit ;; - KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) - echo pdp10-dec-tops20 - exit ;; - XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) - echo pdp10-xkl-tops20 - exit ;; - *:TOPS-20:*:*) - echo pdp10-unknown-tops20 - exit ;; - *:ITS:*:*) - echo pdp10-unknown-its - exit ;; - SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} - exit ;; - *:DragonFly:*:*) - echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` - exit ;; - *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` - case "${UNAME_MACHINE}" in - A*) echo alpha-dec-vms ; exit ;; - I*) echo ia64-dec-vms ; exit ;; - V*) echo vax-dec-vms ; exit ;; - esac ;; - *:XENIX:*:SysV) - echo i386-pc-xenix - exit ;; - i*86:skyos:*:*) - echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' - exit ;; - i*86:rdos:*:*) - echo ${UNAME_MACHINE}-pc-rdos - exit ;; - i*86:AROS:*:*) - echo ${UNAME_MACHINE}-pc-aros - exit ;; - x86_64:VMkernel:*:*) - echo ${UNAME_MACHINE}-unknown-esx - exit ;; -esac - -cat >&2 < in order to provide the needed -information to handle your system. - -config.guess timestamp = $timestamp - -uname -m = `(uname -m) 2>/dev/null || echo unknown` -uname -r = `(uname -r) 2>/dev/null || echo unknown` -uname -s = `(uname -s) 2>/dev/null || echo unknown` -uname -v = `(uname -v) 2>/dev/null || echo unknown` - -/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` -/bin/uname -X = `(/bin/uname -X) 2>/dev/null` - -hostinfo = `(hostinfo) 2>/dev/null` -/bin/universe = `(/bin/universe) 2>/dev/null` -/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` -/bin/arch = `(/bin/arch) 2>/dev/null` -/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` -/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` - -UNAME_MACHINE = ${UNAME_MACHINE} -UNAME_RELEASE = ${UNAME_RELEASE} -UNAME_SYSTEM = ${UNAME_SYSTEM} -UNAME_VERSION = ${UNAME_VERSION} -EOF - -exit 1 - -# Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" -# time-stamp-end: "'" -# End: diff --git a/config.sub b/config.sub deleted file mode 100644 --- a/config.sub +++ /dev/null @@ -1,1794 +0,0 @@ -#! /bin/sh -# Configuration validation subroutine script. -# Copyright 1992-2014 Free Software Foundation, Inc. - -timestamp='2014-05-01' - -# This file is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, see . -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that -# program. This Exception is an additional permission under section 7 -# of the GNU General Public License, version 3 ("GPLv3"). - - -# Please send patches with a ChangeLog entry to config-patches@gnu.org. -# -# Configuration subroutine to validate and canonicalize a configuration type. -# Supply the specified configuration type as an argument. -# If it is invalid, we print an error message on stderr and exit with code 1. -# Otherwise, we print the canonical config type on stdout and succeed. - -# You can get the latest version of this script from: -# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD - -# This file is supposed to be the same for all GNU packages -# and recognize all the CPU types, system types and aliases -# that are meaningful with *any* GNU software. -# Each package is responsible for reporting which valid configurations -# it does not support. The user should be able to distinguish -# a failure to support a valid configuration from a meaningless -# configuration. - -# The goal of this file is to map all the various variations of a given -# machine specification into a single specification in the form: -# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM -# or in some cases, the newer four-part form: -# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM -# It is wrong to echo any other type of specification. - -me=`echo "$0" | sed -e 's,.*/,,'` - -usage="\ -Usage: $0 [OPTION] CPU-MFR-OPSYS - $0 [OPTION] ALIAS - -Canonicalize a configuration name. - -Operation modes: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit - -Report bugs and patches to ." - -version="\ -GNU config.sub ($timestamp) - -Copyright 1992-2014 Free Software Foundation, Inc. - -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -help=" -Try \`$me --help' for more information." - -# Parse command line -while test $# -gt 0 ; do - case $1 in - --time-stamp | --time* | -t ) - echo "$timestamp" ; exit ;; - --version | -v ) - echo "$version" ; exit ;; - --help | --h* | -h ) - echo "$usage"; exit ;; - -- ) # Stop option processing - shift; break ;; - - ) # Use stdin as input. - break ;; - -* ) - echo "$me: invalid option $1$help" - exit 1 ;; - - *local*) - # First pass through any local machine types. - echo $1 - exit ;; - - * ) - break ;; - esac -done - -case $# in - 0) echo "$me: missing argument$help" >&2 - exit 1;; - 1) ;; - *) echo "$me: too many arguments$help" >&2 - exit 1;; -esac - -# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). -# Here we must recognize all the valid KERNEL-OS combinations. -maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` -case $maybe_os in - nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ - linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ - knetbsd*-gnu* | netbsd*-gnu* | \ - kopensolaris*-gnu* | \ - storm-chaos* | os2-emx* | rtmk-nova*) - os=-$maybe_os - basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` - ;; - android-linux) - os=-linux-android - basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown - ;; - *) - basic_machine=`echo $1 | sed 's/-[^-]*$//'` - if [ $basic_machine != $1 ] - then os=`echo $1 | sed 's/.*-/-/'` - else os=; fi - ;; -esac - -### Let's recognize common machines as not being operating systems so -### that things like config.sub decstation-3100 work. We also -### recognize some manufacturers as not being operating systems, so we -### can provide default operating systems below. -case $os in - -sun*os*) - # Prevent following clause from handling this invalid input. - ;; - -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ - -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ - -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ - -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ - -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ - -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray | -microblaze*) - os= - basic_machine=$1 - ;; - -bluegene*) - os=-cnk - ;; - -sim | -cisco | -oki | -wec | -winbond) - os= - basic_machine=$1 - ;; - -scout) - ;; - -wrs) - os=-vxworks - basic_machine=$1 - ;; - -chorusos*) - os=-chorusos - basic_machine=$1 - ;; - -chorusrdb) - os=-chorusrdb - basic_machine=$1 - ;; - -hiux*) - os=-hiuxwe2 - ;; - -sco6) - os=-sco5v6 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco5) - os=-sco3.2v5 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco4) - os=-sco3.2v4 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco3.2.[4-9]*) - os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco3.2v[4-9]*) - # Don't forget version if it is 3.2v4 or newer. - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco5v6*) - # Don't forget version if it is 3.2v4 or newer. - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco*) - os=-sco3.2v2 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -udk*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -isc) - os=-isc2.2 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -clix*) - basic_machine=clipper-intergraph - ;; - -isc*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -lynx*178) - os=-lynxos178 - ;; - -lynx*5) - os=-lynxos5 - ;; - -lynx*) - os=-lynxos - ;; - -ptx*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` - ;; - -windowsnt*) - os=`echo $os | sed -e 's/windowsnt/winnt/'` - ;; - -psos*) - os=-psos - ;; - -mint | -mint[0-9]*) - basic_machine=m68k-atari - os=-mint - ;; -esac - -# Decode aliases for certain CPU-COMPANY combinations. -case $basic_machine in - # Recognize the basic CPU types without company name. - # Some are omitted here because they have special meanings below. - 1750a | 580 \ - | a29k \ - | aarch64 | aarch64_be \ - | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ - | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ - | am33_2.0 \ - | arc | arceb \ - | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ - | avr | avr32 \ - | be32 | be64 \ - | bfin \ - | c4x | c8051 | clipper \ - | d10v | d30v | dlx | dsp16xx \ - | epiphany \ - | fido | fr30 | frv \ - | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ - | hexagon \ - | i370 | i860 | i960 | ia64 \ - | ip2k | iq2000 \ - | k1om \ - | le32 | le64 \ - | lm32 \ - | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ - | mips | mipsbe | mipseb | mipsel | mipsle \ - | mips16 \ - | mips64 | mips64el \ - | mips64octeon | mips64octeonel \ - | mips64orion | mips64orionel \ - | mips64r5900 | mips64r5900el \ - | mips64vr | mips64vrel \ - | mips64vr4100 | mips64vr4100el \ - | mips64vr4300 | mips64vr4300el \ - | mips64vr5000 | mips64vr5000el \ - | mips64vr5900 | mips64vr5900el \ - | mipsisa32 | mipsisa32el \ - | mipsisa32r2 | mipsisa32r2el \ - | mipsisa32r6 | mipsisa32r6el \ - | mipsisa64 | mipsisa64el \ - | mipsisa64r2 | mipsisa64r2el \ - | mipsisa64r6 | mipsisa64r6el \ - | mipsisa64sb1 | mipsisa64sb1el \ - | mipsisa64sr71k | mipsisa64sr71kel \ - | mipsr5900 | mipsr5900el \ - | mipstx39 | mipstx39el \ - | mn10200 | mn10300 \ - | moxie \ - | mt \ - | msp430 \ - | nds32 | nds32le | nds32be \ - | nios | nios2 | nios2eb | nios2el \ - | ns16k | ns32k \ - | open8 | or1k | or1knd | or32 \ - | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle \ - | pyramid \ - | rl78 | rx \ - | score \ - | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ - | sh64 | sh64le \ - | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ - | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu \ - | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ - | ubicom32 \ - | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ - | we32k \ - | x86 | xc16x | xstormy16 | xtensa \ - | z8k | z80) - basic_machine=$basic_machine-unknown - ;; - c54x) - basic_machine=tic54x-unknown - ;; - c55x) - basic_machine=tic55x-unknown - ;; - c6x) - basic_machine=tic6x-unknown - ;; - m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip) - basic_machine=$basic_machine-unknown - os=-none - ;; - m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) - ;; - ms1) - basic_machine=mt-unknown - ;; - - strongarm | thumb | xscale) - basic_machine=arm-unknown - ;; - xgate) - basic_machine=$basic_machine-unknown - os=-none - ;; - xscaleeb) - basic_machine=armeb-unknown - ;; - - xscaleel) - basic_machine=armel-unknown - ;; - - # We use `pc' rather than `unknown' - # because (1) that's what they normally are, and - # (2) the word "unknown" tends to confuse beginning users. - i*86 | x86_64) - basic_machine=$basic_machine-pc - ;; - # Object if more than one company name word. - *-*-*) - echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 - exit 1 - ;; - # Recognize the basic CPU types with company name. - 580-* \ - | a29k-* \ - | aarch64-* | aarch64_be-* \ - | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ - | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ - | alphapca5[67]-* | alpha64pca5[67]-* | arc-* | arceb-* \ - | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ - | avr-* | avr32-* \ - | be32-* | be64-* \ - | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* \ - | c8051-* | clipper-* | craynv-* | cydra-* \ - | d10v-* | d30v-* | dlx-* \ - | elxsi-* \ - | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ - | h8300-* | h8500-* \ - | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ - | hexagon-* \ - | i*86-* | i860-* | i960-* | ia64-* \ - | ip2k-* | iq2000-* \ - | k1om-* \ - | le32-* | le64-* \ - | lm32-* \ - | m32c-* | m32r-* | m32rle-* \ - | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ - | microblaze-* | microblazeel-* \ - | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ - | mips16-* \ - | mips64-* | mips64el-* \ - | mips64octeon-* | mips64octeonel-* \ - | mips64orion-* | mips64orionel-* \ - | mips64r5900-* | mips64r5900el-* \ - | mips64vr-* | mips64vrel-* \ - | mips64vr4100-* | mips64vr4100el-* \ - | mips64vr4300-* | mips64vr4300el-* \ - | mips64vr5000-* | mips64vr5000el-* \ - | mips64vr5900-* | mips64vr5900el-* \ - | mipsisa32-* | mipsisa32el-* \ - | mipsisa32r2-* | mipsisa32r2el-* \ - | mipsisa32r6-* | mipsisa32r6el-* \ - | mipsisa64-* | mipsisa64el-* \ - | mipsisa64r2-* | mipsisa64r2el-* \ - | mipsisa64r6-* | mipsisa64r6el-* \ - | mipsisa64sb1-* | mipsisa64sb1el-* \ - | mipsisa64sr71k-* | mipsisa64sr71kel-* \ - | mipsr5900-* | mipsr5900el-* \ - | mipstx39-* | mipstx39el-* \ - | mmix-* \ - | mt-* \ - | msp430-* \ - | nds32-* | nds32le-* | nds32be-* \ - | nios-* | nios2-* | nios2eb-* | nios2el-* \ - | none-* | np1-* | ns16k-* | ns32k-* \ - | open8-* \ - | or1k*-* \ - | orion-* \ - | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ - | pyramid-* \ - | rl78-* | romp-* | rs6000-* | rx-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ - | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ - | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ - | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ - | tahoe-* \ - | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ - | tile*-* \ - | tron-* \ - | ubicom32-* \ - | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ - | vax-* \ - | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* \ - | xstormy16-* | xtensa*-* \ - | ymp-* \ - | z8k-* | z80-*) - ;; - # Recognize the basic CPU types without company name, with glob match. - xtensa*) - basic_machine=$basic_machine-unknown - ;; - # Recognize the various machine names and aliases which stand - # for a CPU type and a company and sometimes even an OS. - 386bsd) - basic_machine=i386-unknown - os=-bsd - ;; - 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) - basic_machine=m68000-att - ;; - 3b*) - basic_machine=we32k-att - ;; - a29khif) - basic_machine=a29k-amd - os=-udi - ;; - abacus) - basic_machine=abacus-unknown - ;; - adobe68k) - basic_machine=m68010-adobe - os=-scout - ;; - alliant | fx80) - basic_machine=fx80-alliant - ;; - altos | altos3068) - basic_machine=m68k-altos - ;; - am29k) - basic_machine=a29k-none - os=-bsd - ;; - amd64) - basic_machine=x86_64-pc - ;; - amd64-*) - basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - amdahl) - basic_machine=580-amdahl - os=-sysv - ;; - amiga | amiga-*) - basic_machine=m68k-unknown - ;; - amigaos | amigados) - basic_machine=m68k-unknown - os=-amigaos - ;; - amigaunix | amix) - basic_machine=m68k-unknown - os=-sysv4 - ;; - apollo68) - basic_machine=m68k-apollo - os=-sysv - ;; - apollo68bsd) - basic_machine=m68k-apollo - os=-bsd - ;; - aros) - basic_machine=i386-pc - os=-aros - ;; - aux) - basic_machine=m68k-apple - os=-aux - ;; - balance) - basic_machine=ns32k-sequent - os=-dynix - ;; - blackfin) - basic_machine=bfin-unknown - os=-linux - ;; - blackfin-*) - basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` - os=-linux - ;; - bluegene*) - basic_machine=powerpc-ibm - os=-cnk - ;; - c54x-*) - basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - c55x-*) - basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - c6x-*) - basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - c90) - basic_machine=c90-cray - os=-unicos - ;; - cegcc) - basic_machine=arm-unknown - os=-cegcc - ;; - convex-c1) - basic_machine=c1-convex - os=-bsd - ;; - convex-c2) - basic_machine=c2-convex - os=-bsd - ;; - convex-c32) - basic_machine=c32-convex - os=-bsd - ;; - convex-c34) - basic_machine=c34-convex - os=-bsd - ;; - convex-c38) - basic_machine=c38-convex - os=-bsd - ;; - cray | j90) - basic_machine=j90-cray - os=-unicos - ;; - craynv) - basic_machine=craynv-cray - os=-unicosmp - ;; - cr16 | cr16-*) - basic_machine=cr16-unknown - os=-elf - ;; - crds | unos) - basic_machine=m68k-crds - ;; - crisv32 | crisv32-* | etraxfs*) - basic_machine=crisv32-axis - ;; - cris | cris-* | etrax*) - basic_machine=cris-axis - ;; - crx) - basic_machine=crx-unknown - os=-elf - ;; - da30 | da30-*) - basic_machine=m68k-da30 - ;; - decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) - basic_machine=mips-dec - ;; - decsystem10* | dec10*) - basic_machine=pdp10-dec - os=-tops10 - ;; - decsystem20* | dec20*) - basic_machine=pdp10-dec - os=-tops20 - ;; - delta | 3300 | motorola-3300 | motorola-delta \ - | 3300-motorola | delta-motorola) - basic_machine=m68k-motorola - ;; - delta88) - basic_machine=m88k-motorola - os=-sysv3 - ;; - dicos) - basic_machine=i686-pc - os=-dicos - ;; - djgpp) - basic_machine=i586-pc - os=-msdosdjgpp - ;; - dpx20 | dpx20-*) - basic_machine=rs6000-bull - os=-bosx - ;; - dpx2* | dpx2*-bull) - basic_machine=m68k-bull - os=-sysv3 - ;; - ebmon29k) - basic_machine=a29k-amd - os=-ebmon - ;; - elxsi) - basic_machine=elxsi-elxsi - os=-bsd - ;; - encore | umax | mmax) - basic_machine=ns32k-encore - ;; - es1800 | OSE68k | ose68k | ose | OSE) - basic_machine=m68k-ericsson - os=-ose - ;; - fx2800) - basic_machine=i860-alliant - ;; - genix) - basic_machine=ns32k-ns - ;; - gmicro) - basic_machine=tron-gmicro - os=-sysv - ;; - go32) - basic_machine=i386-pc - os=-go32 - ;; - h3050r* | hiux*) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - h8300hms) - basic_machine=h8300-hitachi - os=-hms - ;; - h8300xray) - basic_machine=h8300-hitachi - os=-xray - ;; - h8500hms) - basic_machine=h8500-hitachi - os=-hms - ;; - harris) - basic_machine=m88k-harris - os=-sysv3 - ;; - hp300-*) - basic_machine=m68k-hp - ;; - hp300bsd) - basic_machine=m68k-hp - os=-bsd - ;; - hp300hpux) - basic_machine=m68k-hp - os=-hpux - ;; - hp3k9[0-9][0-9] | hp9[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hp9k2[0-9][0-9] | hp9k31[0-9]) - basic_machine=m68000-hp - ;; - hp9k3[2-9][0-9]) - basic_machine=m68k-hp - ;; - hp9k6[0-9][0-9] | hp6[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hp9k7[0-79][0-9] | hp7[0-79][0-9]) - basic_machine=hppa1.1-hp - ;; - hp9k78[0-9] | hp78[0-9]) - # FIXME: really hppa2.0-hp - basic_machine=hppa1.1-hp - ;; - hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) - # FIXME: really hppa2.0-hp - basic_machine=hppa1.1-hp - ;; - hp9k8[0-9][13679] | hp8[0-9][13679]) - basic_machine=hppa1.1-hp - ;; - hp9k8[0-9][0-9] | hp8[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hppa-next) - os=-nextstep3 - ;; - hppaosf) - basic_machine=hppa1.1-hp - os=-osf - ;; - hppro) - basic_machine=hppa1.1-hp - os=-proelf - ;; - i370-ibm* | ibm*) - basic_machine=i370-ibm - ;; - i*86v32) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv32 - ;; - i*86v4*) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv4 - ;; - i*86v) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv - ;; - i*86sol2) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-solaris2 - ;; - i386mach) - basic_machine=i386-mach - os=-mach - ;; - i386-vsta | vsta) - basic_machine=i386-unknown - os=-vsta - ;; - iris | iris4d) - basic_machine=mips-sgi - case $os in - -irix*) - ;; - *) - os=-irix4 - ;; - esac - ;; - isi68 | isi) - basic_machine=m68k-isi - os=-sysv - ;; - m68knommu) - basic_machine=m68k-unknown - os=-linux - ;; - m68knommu-*) - basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` - os=-linux - ;; - m88k-omron*) - basic_machine=m88k-omron - ;; - magnum | m3230) - basic_machine=mips-mips - os=-sysv - ;; - merlin) - basic_machine=ns32k-utek - os=-sysv - ;; - microblaze*) - basic_machine=microblaze-xilinx - ;; - mingw64) - basic_machine=x86_64-pc - os=-mingw64 - ;; - mingw32) - basic_machine=i686-pc - os=-mingw32 - ;; - mingw32ce) - basic_machine=arm-unknown - os=-mingw32ce - ;; - miniframe) - basic_machine=m68000-convergent - ;; - *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) - basic_machine=m68k-atari - os=-mint - ;; - mips3*-*) - basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` - ;; - mips3*) - basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown - ;; - monitor) - basic_machine=m68k-rom68k - os=-coff - ;; - morphos) - basic_machine=powerpc-unknown - os=-morphos - ;; - msdos) - basic_machine=i386-pc - os=-msdos - ;; - ms1-*) - basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` - ;; - msys) - basic_machine=i686-pc - os=-msys - ;; - mvs) - basic_machine=i370-ibm - os=-mvs - ;; - nacl) - basic_machine=le32-unknown - os=-nacl - ;; - ncr3000) - basic_machine=i486-ncr - os=-sysv4 - ;; - netbsd386) - basic_machine=i386-unknown - os=-netbsd - ;; - netwinder) - basic_machine=armv4l-rebel - os=-linux - ;; - news | news700 | news800 | news900) - basic_machine=m68k-sony - os=-newsos - ;; - news1000) - basic_machine=m68030-sony - os=-newsos - ;; - news-3600 | risc-news) - basic_machine=mips-sony - os=-newsos - ;; - necv70) - basic_machine=v70-nec - os=-sysv - ;; - next | m*-next ) - basic_machine=m68k-next - case $os in - -nextstep* ) - ;; - -ns2*) - os=-nextstep2 - ;; - *) - os=-nextstep3 - ;; - esac - ;; - nh3000) - basic_machine=m68k-harris - os=-cxux - ;; - nh[45]000) - basic_machine=m88k-harris - os=-cxux - ;; - nindy960) - basic_machine=i960-intel - os=-nindy - ;; - mon960) - basic_machine=i960-intel - os=-mon960 - ;; - nonstopux) - basic_machine=mips-compaq - os=-nonstopux - ;; - np1) - basic_machine=np1-gould - ;; - neo-tandem) - basic_machine=neo-tandem - ;; - nse-tandem) - basic_machine=nse-tandem - ;; - nsr-tandem) - basic_machine=nsr-tandem - ;; - op50n-* | op60c-*) - basic_machine=hppa1.1-oki - os=-proelf - ;; - openrisc | openrisc-*) - basic_machine=or32-unknown - ;; - os400) - basic_machine=powerpc-ibm - os=-os400 - ;; - OSE68000 | ose68000) - basic_machine=m68000-ericsson - os=-ose - ;; - os68k) - basic_machine=m68k-none - os=-os68k - ;; - pa-hitachi) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - paragon) - basic_machine=i860-intel - os=-osf - ;; - parisc) - basic_machine=hppa-unknown - os=-linux - ;; - parisc-*) - basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` - os=-linux - ;; - pbd) - basic_machine=sparc-tti - ;; - pbb) - basic_machine=m68k-tti - ;; - pc532 | pc532-*) - basic_machine=ns32k-pc532 - ;; - pc98) - basic_machine=i386-pc - ;; - pc98-*) - basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentium | p5 | k5 | k6 | nexgen | viac3) - basic_machine=i586-pc - ;; - pentiumpro | p6 | 6x86 | athlon | athlon_*) - basic_machine=i686-pc - ;; - pentiumii | pentium2 | pentiumiii | pentium3) - basic_machine=i686-pc - ;; - pentium4) - basic_machine=i786-pc - ;; - pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) - basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentiumpro-* | p6-* | 6x86-* | athlon-*) - basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) - basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentium4-*) - basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pn) - basic_machine=pn-gould - ;; - power) basic_machine=power-ibm - ;; - ppc | ppcbe) basic_machine=powerpc-unknown - ;; - ppc-* | ppcbe-*) - basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ppcle | powerpclittle | ppc-le | powerpc-little) - basic_machine=powerpcle-unknown - ;; - ppcle-* | powerpclittle-*) - basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ppc64) basic_machine=powerpc64-unknown - ;; - ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ppc64le | powerpc64little | ppc64-le | powerpc64-little) - basic_machine=powerpc64le-unknown - ;; - ppc64le-* | powerpc64little-*) - basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ps2) - basic_machine=i386-ibm - ;; - pw32) - basic_machine=i586-unknown - os=-pw32 - ;; - rdos | rdos64) - basic_machine=x86_64-pc - os=-rdos - ;; - rdos32) - basic_machine=i386-pc - os=-rdos - ;; - rom68k) - basic_machine=m68k-rom68k - os=-coff - ;; - rm[46]00) - basic_machine=mips-siemens - ;; - rtpc | rtpc-*) - basic_machine=romp-ibm - ;; - s390 | s390-*) - basic_machine=s390-ibm - ;; - s390x | s390x-*) - basic_machine=s390x-ibm - ;; - sa29200) - basic_machine=a29k-amd - os=-udi - ;; - sb1) - basic_machine=mipsisa64sb1-unknown - ;; - sb1el) - basic_machine=mipsisa64sb1el-unknown - ;; - sde) - basic_machine=mipsisa32-sde - os=-elf - ;; - sei) - basic_machine=mips-sei - os=-seiux - ;; - sequent) - basic_machine=i386-sequent - ;; - sh) - basic_machine=sh-hitachi - os=-hms - ;; - sh5el) - basic_machine=sh5le-unknown - ;; - sh64) - basic_machine=sh64-unknown - ;; - sparclite-wrs | simso-wrs) - basic_machine=sparclite-wrs - os=-vxworks - ;; - sps7) - basic_machine=m68k-bull - os=-sysv2 - ;; - spur) - basic_machine=spur-unknown - ;; - st2000) - basic_machine=m68k-tandem - ;; - stratus) - basic_machine=i860-stratus - os=-sysv4 - ;; - strongarm-* | thumb-*) - basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - sun2) - basic_machine=m68000-sun - ;; - sun2os3) - basic_machine=m68000-sun - os=-sunos3 - ;; - sun2os4) - basic_machine=m68000-sun - os=-sunos4 - ;; - sun3os3) - basic_machine=m68k-sun - os=-sunos3 - ;; - sun3os4) - basic_machine=m68k-sun - os=-sunos4 - ;; - sun4os3) - basic_machine=sparc-sun - os=-sunos3 - ;; - sun4os4) - basic_machine=sparc-sun - os=-sunos4 - ;; - sun4sol2) - basic_machine=sparc-sun - os=-solaris2 - ;; - sun3 | sun3-*) - basic_machine=m68k-sun - ;; - sun4) - basic_machine=sparc-sun - ;; - sun386 | sun386i | roadrunner) - basic_machine=i386-sun - ;; - sv1) - basic_machine=sv1-cray - os=-unicos - ;; - symmetry) - basic_machine=i386-sequent - os=-dynix - ;; - t3e) - basic_machine=alphaev5-cray - os=-unicos - ;; - t90) - basic_machine=t90-cray - os=-unicos - ;; - tile*) - basic_machine=$basic_machine-unknown - os=-linux-gnu - ;; - tx39) - basic_machine=mipstx39-unknown - ;; - tx39el) - basic_machine=mipstx39el-unknown - ;; - toad1) - basic_machine=pdp10-xkl - os=-tops20 - ;; - tower | tower-32) - basic_machine=m68k-ncr - ;; - tpf) - basic_machine=s390x-ibm - os=-tpf - ;; - udi29k) - basic_machine=a29k-amd - os=-udi - ;; - ultra3) - basic_machine=a29k-nyu - os=-sym1 - ;; - v810 | necv810) - basic_machine=v810-nec - os=-none - ;; - vaxv) - basic_machine=vax-dec - os=-sysv - ;; - vms) - basic_machine=vax-dec - os=-vms - ;; - vpp*|vx|vx-*) - basic_machine=f301-fujitsu - ;; - vxworks960) - basic_machine=i960-wrs - os=-vxworks - ;; - vxworks68) - basic_machine=m68k-wrs - os=-vxworks - ;; - vxworks29k) - basic_machine=a29k-wrs - os=-vxworks - ;; - w65*) - basic_machine=w65-wdc - os=-none - ;; - w89k-*) - basic_machine=hppa1.1-winbond - os=-proelf - ;; - xbox) - basic_machine=i686-pc - os=-mingw32 - ;; - xps | xps100) - basic_machine=xps100-honeywell - ;; - xscale-* | xscalee[bl]-*) - basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` - ;; - ymp) - basic_machine=ymp-cray - os=-unicos - ;; - z8k-*-coff) - basic_machine=z8k-unknown - os=-sim - ;; - z80-*-coff) - basic_machine=z80-unknown - os=-sim - ;; - none) - basic_machine=none-none - os=-none - ;; - -# Here we handle the default manufacturer of certain CPU types. It is in -# some cases the only manufacturer, in others, it is the most popular. - w89k) - basic_machine=hppa1.1-winbond - ;; - op50n) - basic_machine=hppa1.1-oki - ;; - op60c) - basic_machine=hppa1.1-oki - ;; - romp) - basic_machine=romp-ibm - ;; - mmix) - basic_machine=mmix-knuth - ;; - rs6000) - basic_machine=rs6000-ibm - ;; - vax) - basic_machine=vax-dec - ;; - pdp10) - # there are many clones, so DEC is not a safe bet - basic_machine=pdp10-unknown - ;; - pdp11) - basic_machine=pdp11-dec - ;; - we32k) - basic_machine=we32k-att - ;; - sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) - basic_machine=sh-unknown - ;; - sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) - basic_machine=sparc-sun - ;; - cydra) - basic_machine=cydra-cydrome - ;; - orion) - basic_machine=orion-highlevel - ;; - orion105) - basic_machine=clipper-highlevel - ;; - mac | mpw | mac-mpw) - basic_machine=m68k-apple - ;; - pmac | pmac-mpw) - basic_machine=powerpc-apple - ;; - *-unknown) - # Make sure to match an already-canonicalized machine name. - ;; - *) - echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 - exit 1 - ;; -esac - -# Here we canonicalize certain aliases for manufacturers. -case $basic_machine in - *-digital*) - basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` - ;; - *-commodore*) - basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` - ;; - *) - ;; -esac - -# Decode manufacturer-specific aliases for certain operating systems. - -if [ x"$os" != x"" ] -then -case $os in - # First match some system type aliases - # that might get confused with valid system types. - # -solaris* is a basic system type, with this one exception. - -auroraux) - os=-auroraux - ;; - -solaris1 | -solaris1.*) - os=`echo $os | sed -e 's|solaris1|sunos4|'` - ;; - -solaris) - os=-solaris2 - ;; - -svr4*) - os=-sysv4 - ;; - -unixware*) - os=-sysv4.2uw - ;; - -gnu/linux*) - os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` - ;; - # First accept the basic system types. - # The portable systems comes first. - # Each alternative MUST END IN A *, to match a version number. - # -sysv* is not here because it comes later, after sysvr4. - -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ - | -sym* | -kopensolaris* | -plan9* \ - | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* | -aros* \ - | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ - | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ - | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ - | -bitrig* | -openbsd* | -solidbsd* \ - | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ - | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ - | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ - | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* | -cegcc* \ - | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ - | -linux-newlib* | -linux-musl* | -linux-uclibc* \ - | -uxpv* | -beos* | -mpeix* | -udk* \ - | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ - | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ - | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ - | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ - | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ - | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es* | -tirtos*) - # Remember, each alternative MUST END IN *, to match a version number. - ;; - -qnx*) - case $basic_machine in - x86-* | i*86-*) - ;; - *) - os=-nto$os - ;; - esac - ;; - -nto-qnx*) - ;; - -nto*) - os=`echo $os | sed -e 's|nto|nto-qnx|'` - ;; - -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ - | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ - | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) - ;; - -mac*) - os=`echo $os | sed -e 's|mac|macos|'` - ;; - -linux-dietlibc) - os=-linux-dietlibc - ;; - -linux*) - os=`echo $os | sed -e 's|linux|linux-gnu|'` - ;; - -sunos5*) - os=`echo $os | sed -e 's|sunos5|solaris2|'` - ;; - -sunos6*) - os=`echo $os | sed -e 's|sunos6|solaris3|'` - ;; - -opened*) - os=-openedition - ;; - -os400*) - os=-os400 - ;; - -wince*) - os=-wince - ;; - -osfrose*) - os=-osfrose - ;; - -osf*) - os=-osf - ;; - -utek*) - os=-bsd - ;; - -dynix*) - os=-bsd - ;; - -acis*) - os=-aos - ;; - -atheos*) - os=-atheos - ;; - -syllable*) - os=-syllable - ;; - -386bsd) - os=-bsd - ;; - -ctix* | -uts*) - os=-sysv - ;; - -nova*) - os=-rtmk-nova - ;; - -ns2 ) - os=-nextstep2 - ;; - -nsk*) - os=-nsk - ;; - # Preserve the version number of sinix5. - -sinix5.*) - os=`echo $os | sed -e 's|sinix|sysv|'` - ;; - -sinix*) - os=-sysv4 - ;; - -tpf*) - os=-tpf - ;; - -triton*) - os=-sysv3 - ;; - -oss*) - os=-sysv3 - ;; - -svr4) - os=-sysv4 - ;; - -svr3) - os=-sysv3 - ;; - -sysvr4) - os=-sysv4 - ;; - # This must come after -sysvr4. - -sysv*) - ;; - -ose*) - os=-ose - ;; - -es1800*) - os=-ose - ;; - -xenix) - os=-xenix - ;; - -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) - os=-mint - ;; - -aros*) - os=-aros - ;; - -zvmoe) - os=-zvmoe - ;; - -dicos*) - os=-dicos - ;; - -nacl*) - ;; - -none) - ;; - *) - # Get rid of the `-' at the beginning of $os. - os=`echo $os | sed 's/[^-]*-//'` - echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 - exit 1 - ;; -esac -else - -# Here we handle the default operating systems that come with various machines. -# The value should be what the vendor currently ships out the door with their -# machine or put another way, the most popular os provided with the machine. - -# Note that if you're going to try to match "-MANUFACTURER" here (say, -# "-sun"), then you have to tell the case statement up towards the top -# that MANUFACTURER isn't an operating system. Otherwise, code above -# will signal an error saying that MANUFACTURER isn't an operating -# system, and we'll never get to this point. - -case $basic_machine in - score-*) - os=-elf - ;; - spu-*) - os=-elf - ;; - *-acorn) - os=-riscix1.2 - ;; - arm*-rebel) - os=-linux - ;; - arm*-semi) - os=-aout - ;; - c4x-* | tic4x-*) - os=-coff - ;; - c8051-*) - os=-elf - ;; - hexagon-*) - os=-elf - ;; - tic54x-*) - os=-coff - ;; - tic55x-*) - os=-coff - ;; - tic6x-*) - os=-coff - ;; - # This must come before the *-dec entry. - pdp10-*) - os=-tops20 - ;; - pdp11-*) - os=-none - ;; - *-dec | vax-*) - os=-ultrix4.2 - ;; - m68*-apollo) - os=-domain - ;; - i386-sun) - os=-sunos4.0.2 - ;; - m68000-sun) - os=-sunos3 - ;; - m68*-cisco) - os=-aout - ;; - mep-*) - os=-elf - ;; - mips*-cisco) - os=-elf - ;; - mips*-*) - os=-elf - ;; - or32-*) - os=-coff - ;; - *-tti) # must be before sparc entry or we get the wrong os. - os=-sysv3 - ;; - sparc-* | *-sun) - os=-sunos4.1.1 - ;; - *-be) - os=-beos - ;; - *-haiku) - os=-haiku - ;; - *-ibm) - os=-aix - ;; - *-knuth) - os=-mmixware - ;; - *-wec) - os=-proelf - ;; - *-winbond) - os=-proelf - ;; - *-oki) - os=-proelf - ;; - *-hp) - os=-hpux - ;; - *-hitachi) - os=-hiux - ;; - i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) - os=-sysv - ;; - *-cbm) - os=-amigaos - ;; - *-dg) - os=-dgux - ;; - *-dolphin) - os=-sysv3 - ;; - m68k-ccur) - os=-rtu - ;; - m88k-omron*) - os=-luna - ;; - *-next ) - os=-nextstep - ;; - *-sequent) - os=-ptx - ;; - *-crds) - os=-unos - ;; - *-ns) - os=-genix - ;; - i370-*) - os=-mvs - ;; - *-next) - os=-nextstep3 - ;; - *-gould) - os=-sysv - ;; - *-highlevel) - os=-bsd - ;; - *-encore) - os=-bsd - ;; - *-sgi) - os=-irix - ;; - *-siemens) - os=-sysv4 - ;; - *-masscomp) - os=-rtu - ;; - f30[01]-fujitsu | f700-fujitsu) - os=-uxpv - ;; - *-rom68k) - os=-coff - ;; - *-*bug) - os=-coff - ;; - *-apple) - os=-macos - ;; - *-atari*) - os=-mint - ;; - *) - os=-none - ;; -esac -fi - -# Here we handle the case where we know the os, and the CPU type, but not the -# manufacturer. We pick the logical manufacturer. -vendor=unknown -case $basic_machine in - *-unknown) - case $os in - -riscix*) - vendor=acorn - ;; - -sunos*) - vendor=sun - ;; - -cnk*|-aix*) - vendor=ibm - ;; - -beos*) - vendor=be - ;; - -hpux*) - vendor=hp - ;; - -mpeix*) - vendor=hp - ;; - -hiux*) - vendor=hitachi - ;; - -unos*) - vendor=crds - ;; - -dgux*) - vendor=dg - ;; - -luna*) - vendor=omron - ;; - -genix*) - vendor=ns - ;; - -mvs* | -opened*) - vendor=ibm - ;; - -os400*) - vendor=ibm - ;; - -ptx*) - vendor=sequent - ;; - -tpf*) - vendor=ibm - ;; - -vxsim* | -vxworks* | -windiss*) - vendor=wrs - ;; - -aux*) - vendor=apple - ;; - -hms*) - vendor=hitachi - ;; - -mpw* | -macos*) - vendor=apple - ;; - -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) - vendor=atari - ;; - -vos*) - vendor=stratus - ;; - esac - basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` - ;; -esac - -echo $basic_machine$os -exit - -# Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" -# time-stamp-end: "'" -# End: diff --git a/configure b/configure --- a/configure +++ b/configure @@ -1624,6 +1624,119 @@ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_header_compile + +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_link + +# ac_fn_c_check_func LINENO FUNC VAR +# ---------------------------------- +# Tests whether FUNC exists, setting the cache variable VAR accordingly +ac_fn_c_check_func () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Define $2 to an innocuous variant, in case declares $2. + For example, HP-UX 11i declares gettimeofday. */ +#define $2 innocuous_$2 + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $2 (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $2 + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $2 (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$2 || defined __stub___$2 +choke me +#endif + +int +main () +{ +return $2 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_func cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. @@ -3178,7 +3291,7 @@ done -for ac_header in sys/types.h unistd.h sys/stat.h +for ac_header in fcntl.h limits.h sys/types.h sys/stat.h time.h do : as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" @@ -3190,6 +3303,26 @@ fi done + + +for ac_func in utimensat +do : + ac_fn_c_check_func "$LINENO" "utimensat" "ac_cv_func_utimensat" +if test "x$ac_cv_func_utimensat" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_UTIMENSAT 1 +_ACEOF + +fi +done + + +# EXTEXT is defined automatically by AC_PROG_CC; +# we just need to capture it in the header file + +cat >>confdefs.h <<_ACEOF +#define EXE_EXTENSION "$EXEEXT" +_ACEOF cat >confcache <<\_ACEOF diff --git a/configure.ac b/configure.ac --- a/configure.ac +++ b/configure.ac @@ -11,6 +11,13 @@ AC_PROG_CC() # check for specific header (.h) files that we are interested in -AC_CHECK_HEADERS([sys/types.h unistd.h sys/stat.h]) +AC_CHECK_HEADERS([fcntl.h limits.h sys/types.h sys/stat.h time.h]) + +AC_CHECK_FUNCS([utimensat]) + +# EXTEXT is defined automatically by AC_PROG_CC; +# we just need to capture it in the header file +AC_DEFINE_UNQUOTED([EXE_EXTENSION], ["$EXEEXT"], + [Filename extension of executable files]) AC_OUTPUT diff --git a/directory.cabal b/directory.cabal --- a/directory.cabal +++ b/directory.cabal @@ -1,5 +1,5 @@ name: directory -version: 1.2.2.1 +version: 1.2.3.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE @@ -10,7 +10,7 @@ This library provides a basic set of operations for manipulating files and directories in a portable way. category: System -build-type: Custom +build-type: Configure cabal-version: >= 1.10 tested-with: GHC>=7.4.1 @@ -23,31 +23,12 @@ extra-source-files: changelog.md README.md - config.guess - config.sub configure configure.ac directory.buildinfo include/HsDirectoryConfig.h.in - install-sh tests/*.hs - tests/*.stderr - tests/*.stdout - tests/Makefile - tests/all.T - tests/copyFile001dir/source - tests/copyFile002dir/source - tests/createDirectory001.stdout-mingw32 - tests/createDirectoryIfMissing001.stdout-mingw32 - tests/getDirContents002.stderr-mingw32 - tests/getPermissions001.stdout-alpha-dec-osf3 - tests/getPermissions001.stdout-i386-unknown-freebsd - tests/getPermissions001.stdout-i386-unknown-openbsd - tests/getPermissions001.stdout-mingw - tests/getPermissions001.stdout-x86_64-unknown-openbsd - tools/ghc-test-framework.LICENSE - tools/ghc-test-framework.shar - tools/run-tests + tests/util.inl source-repository head type: git @@ -62,6 +43,11 @@ exposed-modules: System.Directory + other-modules: + System.Directory.Internal + System.Directory.Internal.C_utimensat + System.Directory.Internal.Posix + System.Directory.Internal.Windows c-sources: cbits/directory.c @@ -84,10 +70,13 @@ test-suite test default-language: Haskell2010 - other-extensions: CPP ForeignFunctionInterface + other-extensions: BangPatterns, CPP ghc-options: -Wall - hs-source-dirs: tools - build-tools: python, which - main-is: dispatch-tests.hs + hs-source-dirs: tests + main-is: Main.hs type: exitcode-stdio-1.0 - build-depends: base, directory + build-depends: base, directory, filepath, time + if os(windows) + build-depends: Win32 + else + build-depends: unix diff --git a/include/HsDirectory.h b/include/HsDirectory.h --- a/include/HsDirectory.h +++ b/include/HsDirectory.h @@ -6,6 +6,9 @@ * * ---------------------------------------------------------------------------*/ +/* [DEPRECATED] Do not include this header nor HsDirectoryConfig.h. They are + for internal use only and may be removed in future versions. */ + #ifndef __HSDIRECTORY_H__ #define __HSDIRECTORY_H__ @@ -49,10 +52,8 @@ # endif #endif -/* A size that will contain many path names, but not necessarily all - * (PATH_MAX is not defined on systems with unlimited path length, - * e.g. the Hurd). - */ +/* Do not use: it may give the wrong value on systems where PATH_MAX is not + defined (e.g. Hurd). Instead, use System.Directory.Internal.c_PATH_MAX. */ INLINE HsInt __hscore_long_path_size(void) { #ifdef PATH_MAX return PATH_MAX; @@ -67,4 +68,3 @@ INLINE mode_t __hscore_S_IFDIR(void) { return S_IFDIR; } #endif /* __HSDIRECTORY_H__ */ - diff --git a/include/HsDirectoryConfig.h.in b/include/HsDirectoryConfig.h.in --- a/include/HsDirectoryConfig.h.in +++ b/include/HsDirectoryConfig.h.in @@ -1,8 +1,17 @@ /* include/HsDirectoryConfig.h.in. Generated from configure.ac by autoheader. */ +/* Filename extension of executable files */ +#undef EXE_EXTENSION + +/* Define to 1 if you have the header file. */ +#undef HAVE_FCNTL_H + /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H +/* Define to 1 if you have the header file. */ +#undef HAVE_LIMITS_H + /* Define to 1 if you have the header file. */ #undef HAVE_MEMORY_H @@ -24,8 +33,14 @@ /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TYPES_H +/* Define to 1 if you have the header file. */ +#undef HAVE_TIME_H + /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H + +/* Define to 1 if you have the `utimensat' function. */ +#undef HAVE_UTIMENSAT /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT diff --git a/install-sh b/install-sh deleted file mode 100644 --- a/install-sh +++ /dev/null @@ -1,527 +0,0 @@ -#!/bin/sh -# install - install a program, script, or datafile - -scriptversion=2011-11-20.07; # UTC - -# This originates from X11R5 (mit/util/scripts/install.sh), which was -# later released in X11R6 (xc/config/util/install.sh) with the -# following copyright and license. -# -# Copyright (C) 1994 X Consortium -# -# Permission is hereby granted, free of charge, to any person obtaining a copy -# of this software and associated documentation files (the "Software"), to -# deal in the Software without restriction, including without limitation the -# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or -# sell copies of the Software, and to permit persons to whom the Software is -# furnished to do so, subject to the following conditions: -# -# The above copyright notice and this permission notice shall be included in -# all copies or substantial portions of the Software. -# -# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN -# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- -# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -# -# Except as contained in this notice, the name of the X Consortium shall not -# be used in advertising or otherwise to promote the sale, use or other deal- -# ings in this Software without prior written authorization from the X Consor- -# tium. -# -# -# FSF changes to this file are in the public domain. -# -# Calling this script install-sh is preferred over install.sh, to prevent -# 'make' implicit rules from creating a file called install from it -# when there is no Makefile. -# -# This script is compatible with the BSD install script, but was written -# from scratch. - -nl=' -' -IFS=" "" $nl" - -# set DOITPROG to echo to test this script - -# Don't use :- since 4.3BSD and earlier shells don't like it. -doit=${DOITPROG-} -if test -z "$doit"; then - doit_exec=exec -else - doit_exec=$doit -fi - -# Put in absolute file names if you don't have them in your path; -# or use environment vars. - -chgrpprog=${CHGRPPROG-chgrp} -chmodprog=${CHMODPROG-chmod} -chownprog=${CHOWNPROG-chown} -cmpprog=${CMPPROG-cmp} -cpprog=${CPPROG-cp} -mkdirprog=${MKDIRPROG-mkdir} -mvprog=${MVPROG-mv} -rmprog=${RMPROG-rm} -stripprog=${STRIPPROG-strip} - -posix_glob='?' -initialize_posix_glob=' - test "$posix_glob" != "?" || { - if (set -f) 2>/dev/null; then - posix_glob= - else - posix_glob=: - fi - } -' - -posix_mkdir= - -# Desired mode of installed file. -mode=0755 - -chgrpcmd= -chmodcmd=$chmodprog -chowncmd= -mvcmd=$mvprog -rmcmd="$rmprog -f" -stripcmd= - -src= -dst= -dir_arg= -dst_arg= - -copy_on_change=false -no_target_directory= - -usage="\ -Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE - or: $0 [OPTION]... SRCFILES... DIRECTORY - or: $0 [OPTION]... -t DIRECTORY SRCFILES... - or: $0 [OPTION]... -d DIRECTORIES... - -In the 1st form, copy SRCFILE to DSTFILE. -In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. -In the 4th, create DIRECTORIES. - -Options: - --help display this help and exit. - --version display version info and exit. - - -c (ignored) - -C install only if different (preserve the last data modification time) - -d create directories instead of installing files. - -g GROUP $chgrpprog installed files to GROUP. - -m MODE $chmodprog installed files to MODE. - -o USER $chownprog installed files to USER. - -s $stripprog installed files. - -t DIRECTORY install into DIRECTORY. - -T report an error if DSTFILE is a directory. - -Environment variables override the default commands: - CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG - RMPROG STRIPPROG -" - -while test $# -ne 0; do - case $1 in - -c) ;; - - -C) copy_on_change=true;; - - -d) dir_arg=true;; - - -g) chgrpcmd="$chgrpprog $2" - shift;; - - --help) echo "$usage"; exit $?;; - - -m) mode=$2 - case $mode in - *' '* | *' '* | *' -'* | *'*'* | *'?'* | *'['*) - echo "$0: invalid mode: $mode" >&2 - exit 1;; - esac - shift;; - - -o) chowncmd="$chownprog $2" - shift;; - - -s) stripcmd=$stripprog;; - - -t) dst_arg=$2 - # Protect names problematic for 'test' and other utilities. - case $dst_arg in - -* | [=\(\)!]) dst_arg=./$dst_arg;; - esac - shift;; - - -T) no_target_directory=true;; - - --version) echo "$0 $scriptversion"; exit $?;; - - --) shift - break;; - - -*) echo "$0: invalid option: $1" >&2 - exit 1;; - - *) break;; - esac - shift -done - -if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then - # When -d is used, all remaining arguments are directories to create. - # When -t is used, the destination is already specified. - # Otherwise, the last argument is the destination. Remove it from $@. - for arg - do - if test -n "$dst_arg"; then - # $@ is not empty: it contains at least $arg. - set fnord "$@" "$dst_arg" - shift # fnord - fi - shift # arg - dst_arg=$arg - # Protect names problematic for 'test' and other utilities. - case $dst_arg in - -* | [=\(\)!]) dst_arg=./$dst_arg;; - esac - done -fi - -if test $# -eq 0; then - if test -z "$dir_arg"; then - echo "$0: no input file specified." >&2 - exit 1 - fi - # It's OK to call 'install-sh -d' without argument. - # This can happen when creating conditional directories. - exit 0 -fi - -if test -z "$dir_arg"; then - do_exit='(exit $ret); exit $ret' - trap "ret=129; $do_exit" 1 - trap "ret=130; $do_exit" 2 - trap "ret=141; $do_exit" 13 - trap "ret=143; $do_exit" 15 - - # Set umask so as not to create temps with too-generous modes. - # However, 'strip' requires both read and write access to temps. - case $mode in - # Optimize common cases. - *644) cp_umask=133;; - *755) cp_umask=22;; - - *[0-7]) - if test -z "$stripcmd"; then - u_plus_rw= - else - u_plus_rw='% 200' - fi - cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; - *) - if test -z "$stripcmd"; then - u_plus_rw= - else - u_plus_rw=,u+rw - fi - cp_umask=$mode$u_plus_rw;; - esac -fi - -for src -do - # Protect names problematic for 'test' and other utilities. - case $src in - -* | [=\(\)!]) src=./$src;; - esac - - if test -n "$dir_arg"; then - dst=$src - dstdir=$dst - test -d "$dstdir" - dstdir_status=$? - else - - # Waiting for this to be detected by the "$cpprog $src $dsttmp" command - # might cause directories to be created, which would be especially bad - # if $src (and thus $dsttmp) contains '*'. - if test ! -f "$src" && test ! -d "$src"; then - echo "$0: $src does not exist." >&2 - exit 1 - fi - - if test -z "$dst_arg"; then - echo "$0: no destination specified." >&2 - exit 1 - fi - dst=$dst_arg - - # If destination is a directory, append the input filename; won't work - # if double slashes aren't ignored. - if test -d "$dst"; then - if test -n "$no_target_directory"; then - echo "$0: $dst_arg: Is a directory" >&2 - exit 1 - fi - dstdir=$dst - dst=$dstdir/`basename "$src"` - dstdir_status=0 - else - # Prefer dirname, but fall back on a substitute if dirname fails. - dstdir=` - (dirname "$dst") 2>/dev/null || - expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$dst" : 'X\(//\)[^/]' \| \ - X"$dst" : 'X\(//\)$' \| \ - X"$dst" : 'X\(/\)' \| . 2>/dev/null || - echo X"$dst" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q' - ` - - test -d "$dstdir" - dstdir_status=$? - fi - fi - - obsolete_mkdir_used=false - - if test $dstdir_status != 0; then - case $posix_mkdir in - '') - # Create intermediate dirs using mode 755 as modified by the umask. - # This is like FreeBSD 'install' as of 1997-10-28. - umask=`umask` - case $stripcmd.$umask in - # Optimize common cases. - *[2367][2367]) mkdir_umask=$umask;; - .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;; - - *[0-7]) - mkdir_umask=`expr $umask + 22 \ - - $umask % 100 % 40 + $umask % 20 \ - - $umask % 10 % 4 + $umask % 2 - `;; - *) mkdir_umask=$umask,go-w;; - esac - - # With -d, create the new directory with the user-specified mode. - # Otherwise, rely on $mkdir_umask. - if test -n "$dir_arg"; then - mkdir_mode=-m$mode - else - mkdir_mode= - fi - - posix_mkdir=false - case $umask in - *[123567][0-7][0-7]) - # POSIX mkdir -p sets u+wx bits regardless of umask, which - # is incompatible with FreeBSD 'install' when (umask & 300) != 0. - ;; - *) - tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ - trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0 - - if (umask $mkdir_umask && - exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1 - then - if test -z "$dir_arg" || { - # Check for POSIX incompatibilities with -m. - # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or - # other-writable bit of parent directory when it shouldn't. - # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. - ls_ld_tmpdir=`ls -ld "$tmpdir"` - case $ls_ld_tmpdir in - d????-?r-*) different_mode=700;; - d????-?--*) different_mode=755;; - *) false;; - esac && - $mkdirprog -m$different_mode -p -- "$tmpdir" && { - ls_ld_tmpdir_1=`ls -ld "$tmpdir"` - test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" - } - } - then posix_mkdir=: - fi - rmdir "$tmpdir/d" "$tmpdir" - else - # Remove any dirs left behind by ancient mkdir implementations. - rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null - fi - trap '' 0;; - esac;; - esac - - if - $posix_mkdir && ( - umask $mkdir_umask && - $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" - ) - then : - else - - # The umask is ridiculous, or mkdir does not conform to POSIX, - # or it failed possibly due to a race condition. Create the - # directory the slow way, step by step, checking for races as we go. - - case $dstdir in - /*) prefix='/';; - [-=\(\)!]*) prefix='./';; - *) prefix='';; - esac - - eval "$initialize_posix_glob" - - oIFS=$IFS - IFS=/ - $posix_glob set -f - set fnord $dstdir - shift - $posix_glob set +f - IFS=$oIFS - - prefixes= - - for d - do - test X"$d" = X && continue - - prefix=$prefix$d - if test -d "$prefix"; then - prefixes= - else - if $posix_mkdir; then - (umask=$mkdir_umask && - $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break - # Don't fail if two instances are running concurrently. - test -d "$prefix" || exit 1 - else - case $prefix in - *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; - *) qprefix=$prefix;; - esac - prefixes="$prefixes '$qprefix'" - fi - fi - prefix=$prefix/ - done - - if test -n "$prefixes"; then - # Don't fail if two instances are running concurrently. - (umask $mkdir_umask && - eval "\$doit_exec \$mkdirprog $prefixes") || - test -d "$dstdir" || exit 1 - obsolete_mkdir_used=true - fi - fi - fi - - if test -n "$dir_arg"; then - { test -z "$chowncmd" || $doit $chowncmd "$dst"; } && - { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } && - { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false || - test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1 - else - - # Make a couple of temp file names in the proper directory. - dsttmp=$dstdir/_inst.$$_ - rmtmp=$dstdir/_rm.$$_ - - # Trap to clean up those temp files at exit. - trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 - - # Copy the file name to the temp name. - (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") && - - # and set any options; do chmod last to preserve setuid bits. - # - # If any of these fail, we abort the whole thing. If we want to - # ignore errors from any of these, just make sure not to ignore - # errors from the above "$doit $cpprog $src $dsttmp" command. - # - { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } && - { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } && - { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } && - { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } && - - # If -C, don't bother to copy if it wouldn't change the file. - if $copy_on_change && - old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && - new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && - - eval "$initialize_posix_glob" && - $posix_glob set -f && - set X $old && old=:$2:$4:$5:$6 && - set X $new && new=:$2:$4:$5:$6 && - $posix_glob set +f && - - test "$old" = "$new" && - $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 - then - rm -f "$dsttmp" - else - # Rename the file to the real destination. - $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null || - - # The rename failed, perhaps because mv can't rename something else - # to itself, or perhaps because mv is so ancient that it does not - # support -f. - { - # Now remove or move aside any old file at destination location. - # We try this two ways since rm can't unlink itself on some - # systems and the destination file might be busy for other - # reasons. In this case, the final cleanup might fail but the new - # file should still install successfully. - { - test ! -f "$dst" || - $doit $rmcmd -f "$dst" 2>/dev/null || - { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && - { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; } - } || - { echo "$0: cannot unlink or rename $dst" >&2 - (exit 1); exit 1 - } - } && - - # Now rename the file to the real destination. - $doit $mvcmd "$dsttmp" "$dst" - } - fi || exit 1 - - trap '' 0 - fi -done - -# Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-time-zone: "UTC" -# time-stamp-end: "; # UTC" -# End: diff --git a/tests/CanonicalizePath.hs b/tests/CanonicalizePath.hs new file mode 100644 --- /dev/null +++ b/tests/CanonicalizePath.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE CPP #-} +module CanonicalizePath where +#include "util.inl" +import System.Directory +import System.FilePath ((), normalise) + +main :: TestEnv -> IO () +main _t = do + dot <- canonicalizePath "." + nul <- canonicalizePath "" + T(expectEq) () dot nul + + writeFile "bar" "" + bar <- canonicalizePath "bar" + T(expectEq) () bar (normalise (dot "bar")) + + createDirectory "foo" + foo <- canonicalizePath "foo/" + T(expectEq) () foo (normalise (dot "foo/")) + + -- should not fail for non-existent paths + fooNon <- canonicalizePath "foo/non-existent" + T(expectEq) () fooNon (normalise (foo "non-existent")) diff --git a/tests/CopyFile001.hs b/tests/CopyFile001.hs new file mode 100644 --- /dev/null +++ b/tests/CopyFile001.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE CPP #-} +module CopyFile001 where +#include "util.inl" +import System.Directory +import Data.List (sort) +import Data.Monoid ((<>)) +import System.FilePath (()) + +main :: TestEnv -> IO () +main _t = do + createDirectory dir + writeFile (dir from) contents + T(expectEq) () (specials <> [from]) . sort =<< getDirectoryContents dir + copyFile (dir from) (dir to) + T(expectEq) () (specials <> [from, to]) . sort =<< getDirectoryContents dir + T(expectEq) () contents =<< readFile (dir to) + where + specials = [".", ".."] + contents = "This is the data\n" + from = "source" + to = "target" + dir = "dir" diff --git a/tests/CopyFile002.hs b/tests/CopyFile002.hs new file mode 100644 --- /dev/null +++ b/tests/CopyFile002.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE CPP #-} +module CopyFile002 where +#include "util.inl" +import System.Directory +import Data.List (sort) +import Data.Monoid ((<>)) + +main :: TestEnv -> IO () +main _t = do + -- Similar to CopyFile001 but moves a file in the current directory + -- (Bug #1652 on GHC Trac) + writeFile from contents + T(expectEq) () (specials <> [from]) . sort =<< getDirectoryContents "." + copyFile from to + T(expectEq) () (specials <> [from, to]) . sort =<< getDirectoryContents "." + T(expectEq) () contents =<< readFile to + where + specials = [".", ".."] + contents = "This is the data\n" + from = "source" + to = "target" diff --git a/tests/CreateDirectory001.hs b/tests/CreateDirectory001.hs new file mode 100644 --- /dev/null +++ b/tests/CreateDirectory001.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE CPP #-} +module CreateDirectory001 where +#include "util.inl" +import System.Directory +import System.IO.Error (isAlreadyExistsError) + +main :: TestEnv -> IO () +main _t = do + createDirectory testdir + T(expectIOErrorType) () isAlreadyExistsError (createDirectory testdir) + where testdir = "dir" diff --git a/tests/CreateDirectoryIfMissing001.hs b/tests/CreateDirectoryIfMissing001.hs new file mode 100644 --- /dev/null +++ b/tests/CreateDirectoryIfMissing001.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE CPP #-} +module CreateDirectoryIfMissing001 where +#include "util.inl" +import System.Directory +import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar) +import qualified Control.Exception as E +import Control.Monad (replicateM_) +import System.FilePath ((), addTrailingPathSeparator) +import System.IO (hFlush, stdout) +import System.IO.Error(isAlreadyExistsError, isDoesNotExistError, + isPermissionError) +#ifndef mingw32_HOST_OS +import GHC.IO.Exception (IOErrorType(InappropriateType)) +import System.IO.Error(ioeGetErrorType) +#endif + +main :: TestEnv -> IO () +main _t = do + + createDirectoryIfMissing False testdir + cleanup + + T(expectIOErrorType) () isDoesNotExistError $ + createDirectoryIfMissing False testdir_a + + createDirectoryIfMissing True testdir_a + createDirectoryIfMissing False testdir_a + createDirectoryIfMissing False (addTrailingPathSeparator testdir_a) + cleanup + + createDirectoryIfMissing True (addTrailingPathSeparator testdir_a) + + putStrLn "testing for race conditions ..." + hFlush stdout + raceCheck1 + raceCheck2 + putStrLn "done." + hFlush stdout + cleanup + + writeFile testdir testdir + T(expectIOErrorType) () isAlreadyExistsError $ + createDirectoryIfMissing False testdir + removeFile testdir + cleanup + + writeFile testdir testdir + T(expectIOErrorType) () isNotADirectoryError $ + createDirectoryIfMissing True testdir_a + removeFile testdir + cleanup + + where + + testdir = "createDirectoryIfMissing001.d" + testdir_a = testdir "a" + + -- Look for race conditions (bug #2808 on GHC Trac). This fails with + -- +RTS -N2 and directory 1.0.0.2. + raceCheck1 = do + m <- newEmptyMVar + _ <- forkIO $ do + replicateM_ 10000 create + putMVar m () + _ <- forkIO $ do + replicateM_ 10000 cleanup + putMVar m () + replicateM_ 2 (takeMVar m) + + -- This test fails on Windows (see bug #2924 on GHC Trac): + raceCheck2 = do + m <- newEmptyMVar + replicateM_ 4 $ + forkIO $ do + replicateM_ 10000 $ do + create + cleanup + putMVar m () + replicateM_ 4 (takeMVar m) + + -- createDirectoryIfMissing is allowed to fail with isDoesNotExistError if + -- another process/thread removes one of the directories during the process + -- of creating the hierarchy. + -- + -- It is also allowed to fail with permission errors + -- (see bug #2924 on GHC Trac) + create = + createDirectoryIfMissing True testdir_a `E.catch` \ e -> + if isDoesNotExistError e || isPermissionError e + then return () + else ioError e + + cleanup = removeDirectoryRecursive testdir `catchAny` \ _ -> return () + + catchAny :: IO a -> (E.SomeException -> IO a) -> IO a + catchAny = E.catch + +#ifdef mingw32_HOST_OS + isNotADirectoryError = isAlreadyExistsError +#else + isNotADirectoryError e = case ioeGetErrorType e of + InappropriateType -> True + _ -> False +#endif diff --git a/tests/CurrentDirectory001.hs b/tests/CurrentDirectory001.hs new file mode 100644 --- /dev/null +++ b/tests/CurrentDirectory001.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE CPP #-} +module CurrentDirectory001 where +#include "util.inl" +import System.Directory +import Data.List (sort) + +main :: TestEnv -> IO () +main _t = do + prevDir <- getCurrentDirectory + createDirectory "dir" + setCurrentDirectory "dir" + T(expectEq) () [".", ".."] . sort =<< getDirectoryContents "." + setCurrentDirectory prevDir + removeDirectory "dir" diff --git a/tests/Directory001.hs b/tests/Directory001.hs new file mode 100644 --- /dev/null +++ b/tests/Directory001.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE CPP #-} +module Directory001 where +#include "util.inl" +import System.Directory + +main :: TestEnv -> IO () +main _t = do + + createDirectory "foo" + writeFile "foo/bar" str + renameFile "foo/bar" "foo/baz" + renameDirectory "foo" "bar" + str' <- readFile "bar/baz" + T(expectEq) () str' str + removeFile "bar/baz" + removeDirectory "bar" + + where + str = "Okay\n" diff --git a/tests/DoesDirectoryExist001.hs b/tests/DoesDirectoryExist001.hs new file mode 100644 --- /dev/null +++ b/tests/DoesDirectoryExist001.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE CPP #-} +module DoesDirectoryExist001 where +#include "util.inl" +import System.Directory + +main :: TestEnv -> IO () +main _t = do + + -- [regression test] "/" was not recognised as a directory prior to GHC 6.1 + T(expect) () =<< doesDirectoryExist rootDir + + where +#ifdef mingw32_HOST_OS + rootDir = "C:\\" +#else + rootDir = "/" +#endif diff --git a/tests/FileTime.hs b/tests/FileTime.hs new file mode 100644 --- /dev/null +++ b/tests/FileTime.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE CPP #-} +module FileTime where +#include "util.inl" +import System.Directory +import System.IO.Error (isDoesNotExistError) +import Data.Foldable (for_) +import qualified Data.Time.Clock as Time + +main :: TestEnv -> IO () +main _t = do + now <- Time.getCurrentTime + let someTimeAgo = Time.addUTCTime (-3600) now + someTimeAgo' = Time.addUTCTime (-7200) now + + T(expectIOErrorType) () isDoesNotExistError $ + getAccessTime "nonexistent-file" + T(expectIOErrorType) () isDoesNotExistError $ + setAccessTime "nonexistent-file" someTimeAgo + T(expectIOErrorType) () isDoesNotExistError $ + getModificationTime "nonexistent-file" + T(expectIOErrorType) () isDoesNotExistError $ + setModificationTime "nonexistent-file" someTimeAgo + + writeFile "foo" "" + for_ [ "foo", ".", "" ] $ \ file -> do + let mtime = someTimeAgo + atime = someTimeAgo' + + atime1 <- getAccessTime file + + setModificationTime file mtime + + atime2 <- getAccessTime file + mtime2 <- getModificationTime file + + -- modification time should be set with at worst 1 sec resolution + T(expectNearTime) file mtime mtime2 1 + + -- access time should not change, although it may lose some precision + -- on POSIX systems without 'utimensat' + T(expectNearTime) file atime1 atime2 1 + + setAccessTime file atime + + atime3 <- getAccessTime file + mtime3 <- getModificationTime file + + -- access time should be set with at worst 1 sec resolution + T(expectNearTime) file atime atime3 1 + + -- modification time should not change, although it may lose some precision + -- on POSIX systems without 'utimensat' + T(expectNearTime) file mtime2 mtime3 1 diff --git a/tests/GetDirContents001.hs b/tests/GetDirContents001.hs new file mode 100644 --- /dev/null +++ b/tests/GetDirContents001.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE CPP #-} +module GetDirContents001 where +#include "util.inl" +import System.Directory +import Data.List (sort) +import Data.Monoid ((<>)) +import Data.Traversable (for) +import System.FilePath (()) + +main :: TestEnv -> IO () +main _t = do + createDirectory dir + T(expectEq) () specials . sort =<< getDirectoryContents dir + names <- for [1 .. 100 :: Int] $ \ i -> do + let name = 'f' : show i + writeFile (dir name) "" + return name + T(expectEq) () (sort (specials <> names)) . sort =<< getDirectoryContents dir + where dir = "dir" + specials = [".", ".."] diff --git a/tests/GetDirContents002.hs b/tests/GetDirContents002.hs new file mode 100644 --- /dev/null +++ b/tests/GetDirContents002.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE CPP #-} +module GetDirContents002 where +#include "util.inl" +import System.Directory +import System.IO.Error (isDoesNotExistError) + +main :: TestEnv -> IO () +main _t = do + T(expectIOErrorType) () isDoesNotExistError $ + getDirectoryContents "nonexistent" diff --git a/tests/GetHomeDirectory001.hs b/tests/GetHomeDirectory001.hs new file mode 100644 --- /dev/null +++ b/tests/GetHomeDirectory001.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE CPP #-} +module GetHomeDirectory001 where +#include "util.inl" +import System.Directory + +main :: TestEnv -> IO () +main _t = do + homeDir <- getHomeDirectory + T(expect) () (homeDir /= "") -- sanity check + _ <- getAppUserDataDirectory "test" + _ <- getXdgDirectory XdgCache "test" + _ <- getXdgDirectory XdgConfig "test" + _ <- getXdgDirectory XdgData "test" + _ <- getUserDocumentsDirectory + _ <- getTemporaryDirectory + return () diff --git a/tests/GetPermissions001.hs b/tests/GetPermissions001.hs new file mode 100644 --- /dev/null +++ b/tests/GetPermissions001.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE CPP #-} +module GetPermissions001 where +#include "util.inl" +import System.Directory + +main :: TestEnv -> IO () +main _t = do + + checkCurrentDir + checkExecutable + checkOrdinary + checkTrailingSlash + + where + + checkCurrentDir = do + -- since the current directory is created by the test runner, + -- it should be readable, writable, and searchable + p <- getPermissions "." + T(expect) () (readable p) + T(expect) () (writable p) + T(expect) () (not (executable p)) + T(expect) () (searchable p) + + checkExecutable = do + -- 'find' expected to exist on both Windows and POSIX, + -- though we have no idea if it's writable + Just f <- findExecutable "find" + p <- getPermissions f + T(expect) () (readable p) + T(expect) () (executable p) + T(expect) () (not (searchable p)) + + checkOrdinary = do + writeFile "foo" "" + p <- getPermissions "foo" + T(expect) () (readable p) + T(expect) () (writable p) + T(expect) () (not (executable p)) + T(expect) () (not (searchable p)) + + -- [regression test] (issue #9) + -- Windows doesn't like trailing path separators + checkTrailingSlash = do + createDirectory "bar" + _ <- getPermissions "bar/" + return () diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,39 @@ +module Main (main) where +import qualified Util as T +import qualified CanonicalizePath +import qualified CopyFile001 +import qualified CopyFile002 +import qualified CreateDirectory001 +import qualified CreateDirectoryIfMissing001 +import qualified CurrentDirectory001 +import qualified Directory001 +import qualified DoesDirectoryExist001 +import qualified FileTime +import qualified GetDirContents001 +import qualified GetDirContents002 +import qualified GetHomeDirectory001 +import qualified GetPermissions001 +import qualified RemoveDirectoryRecursive001 +import qualified RenameFile001 +import qualified T8482 +import qualified WithCurrentDirectory + +main :: IO () +main = T.testMain $ \ _t -> do + T.isolatedRun _t "CanonicalizePath" CanonicalizePath.main + T.isolatedRun _t "CopyFile001" CopyFile001.main + T.isolatedRun _t "CopyFile002" CopyFile002.main + T.isolatedRun _t "CreateDirectory001" CreateDirectory001.main + T.isolatedRun _t "CreateDirectoryIfMissing001" CreateDirectoryIfMissing001.main + T.isolatedRun _t "CurrentDirectory001" CurrentDirectory001.main + T.isolatedRun _t "Directory001" Directory001.main + T.isolatedRun _t "DoesDirectoryExist001" DoesDirectoryExist001.main + T.isolatedRun _t "FileTime" FileTime.main + T.isolatedRun _t "GetDirContents001" GetDirContents001.main + T.isolatedRun _t "GetDirContents002" GetDirContents002.main + T.isolatedRun _t "GetHomeDirectory001" GetHomeDirectory001.main + T.isolatedRun _t "GetPermissions001" GetPermissions001.main + T.isolatedRun _t "RemoveDirectoryRecursive001" RemoveDirectoryRecursive001.main + T.isolatedRun _t "RenameFile001" RenameFile001.main + T.isolatedRun _t "T8482" T8482.main + T.isolatedRun _t "WithCurrentDirectory" WithCurrentDirectory.main diff --git a/tests/Makefile b/tests/Makefile deleted file mode 100644 --- a/tests/Makefile +++ /dev/null @@ -1,7 +0,0 @@ -# This Makefile runs the tests using GHC's testsuite framework. It -# assumes the package is part of a GHC build tree with the testsuite -# installed in ../../../testsuite. - -TOP=../../../testsuite -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk diff --git a/tests/RemoveDirectoryRecursive001.hs b/tests/RemoveDirectoryRecursive001.hs new file mode 100644 --- /dev/null +++ b/tests/RemoveDirectoryRecursive001.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE CPP #-} +module RemoveDirectoryRecursive001 where +#include "util.inl" +import System.Directory +import Data.List (sort) +import System.FilePath ((), normalise) +import System.IO.Error (catchIOError) +import TestUtils + +main :: TestEnv -> IO () +main _t = do + + ------------------------------------------------------------ + -- clean up junk from previous invocations + + modifyPermissions (tmp "c") (\ p -> p { writable = True }) + `catchIOError` \ _ -> return () + removeDirectoryRecursive tmpD + `catchIOError` \ _ -> return () + + ------------------------------------------------------------ + -- set up + + createDirectoryIfMissing True (tmp "a/x/w") + createDirectoryIfMissing True (tmp "a/y") + createDirectoryIfMissing True (tmp "a/z") + createDirectoryIfMissing True (tmp "b") + createDirectoryIfMissing True (tmp "c") + writeFile (tmp "a/x/w/u") "foo" + writeFile (tmp "a/t") "bar" + tryCreateSymbolicLink (normalise "../a") (tmp "b/g") + tryCreateSymbolicLink (normalise "../b") (tmp "c/h") + tryCreateSymbolicLink (normalise "a") (tmp "d") + modifyPermissions (tmp "c") (\ p -> p { writable = False }) + + ------------------------------------------------------------ + -- tests + + T(expectEq) () [".", "..", "a", "b", "c", "d"] . sort =<< + getDirectoryContents tmpD + T(expectEq) () [".", "..", "t", "x", "y", "z"] . sort =<< + getDirectoryContents (tmp "a") + T(expectEq) () [".", "..", "g"] . sort =<< + getDirectoryContents (tmp "b") + T(expectEq) () [".", "..", "h"] . sort =<< + getDirectoryContents (tmp "c") + T(expectEq) () [".", "..", "t", "x", "y", "z"] . sort =<< + getDirectoryContents (tmp "d") + + removeDirectoryRecursive (tmp "d") + `catchIOError` \ _ -> removeFile (tmp "d") +#ifdef mingw32_HOST_OS + `catchIOError` \ _ -> removeDirectory (tmp "d") +#endif + + T(expectEq) () [".", "..", "a", "b", "c"] . sort =<< + getDirectoryContents tmpD + T(expectEq) () [".", "..", "t", "x", "y", "z"] . sort =<< + getDirectoryContents (tmp "a") + T(expectEq) () [".", "..", "g"] . sort =<< + getDirectoryContents (tmp "b") + T(expectEq) () [".", "..", "h"] . sort =<< + getDirectoryContents (tmp "c") + + removeDirectoryRecursive (tmp "c") + `catchIOError` \ _ -> do + modifyPermissions (tmp "c") (\ p -> p { writable = True }) + removeDirectoryRecursive (tmp "c") + + T(expectEq) () [".", "..", "a", "b"] . sort =<< + getDirectoryContents tmpD + T(expectEq) () [".", "..", "t", "x", "y", "z"] . sort =<< + getDirectoryContents (tmp "a") + T(expectEq) () [".", "..", "g"] . sort =<< + getDirectoryContents (tmp "b") + + removeDirectoryRecursive (tmp "b") + + T(expectEq) () [".", "..", "a"] . sort =<< + getDirectoryContents tmpD + T(expectEq) () [".", "..", "t", "x", "y", "z"] . sort =<< + getDirectoryContents (tmp "a") + + removeDirectoryRecursive (tmp "a") + + T(expectEq) () [".", ".."] . sort =<< + getDirectoryContents tmpD + + where testName = "removeDirectoryRecursive001" + tmpD = testName ++ ".tmp" + tmp s = tmpD normalise s diff --git a/tests/RenameFile001.hs b/tests/RenameFile001.hs new file mode 100644 --- /dev/null +++ b/tests/RenameFile001.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE CPP #-} +module RenameFile001 where +#include "util.inl" +import System.Directory + +main :: TestEnv -> IO () +main _t = do + writeFile tmp1 contents1 + renameFile tmp1 tmp2 + T(expectEq) () contents1 =<< readFile tmp2 + writeFile tmp1 contents2 + renameFile tmp2 tmp1 + T(expectEq) () contents1 =<< readFile tmp1 + where + tmp1 = "tmp1" + tmp2 = "tmp2" + contents1 = "test" + contents2 = "test2" diff --git a/tests/T8482.hs b/tests/T8482.hs --- a/tests/T8482.hs +++ b/tests/T8482.hs @@ -1,16 +1,21 @@ +{-# LANGUAGE CPP #-} +module T8482 where +#include "util.inl" +import GHC.IO.Exception (IOErrorType(InappropriateType)) import System.Directory -import Control.Exception +import System.IO.Error (ioeGetErrorType) +tmp1 :: FilePath tmp1 = "T8482.tmp1" + +testdir :: FilePath testdir = "T8482.dir" -main = do +main :: TestEnv -> IO () +main _t = do writeFile tmp1 "hello" createDirectory testdir - tryRenameFile testdir tmp1 >>= print -- InappropriateType - tryRenameFile tmp1 testdir >>= print -- InappropriateType - tryRenameFile tmp1 "." >>= print -- InappropriateType - removeDirectory testdir - removeFile tmp1 - where tryRenameFile :: FilePath -> FilePath -> IO (Either IOException ()) - tryRenameFile opath npath = try $ renameFile opath npath + T(expectIOErrorType) () (is InappropriateType) (renameFile testdir tmp1) + T(expectIOErrorType) () (is InappropriateType) (renameFile tmp1 testdir) + T(expectIOErrorType) () (is InappropriateType) (renameFile tmp1 ".") + where is t = (== t) . ioeGetErrorType diff --git a/tests/T8482.stdout b/tests/T8482.stdout deleted file mode 100644 --- a/tests/T8482.stdout +++ /dev/null @@ -1,3 +0,0 @@ -Left T8482.dir: renameFile: inappropriate type (is a directory) -Left T8482.dir: renameFile: inappropriate type (is a directory) -Left .: renameFile: inappropriate type (is a directory) diff --git a/tests/TestUtils.hs b/tests/TestUtils.hs --- a/tests/TestUtils.hs +++ b/tests/TestUtils.hs @@ -12,7 +12,6 @@ import Foreign (Ptr) import Foreign.C (CUChar(..), CULong(..), CWchar(..), withCWString) import System.FilePath (takeDirectory) -import System.IO (hPutStrLn, stderr) import System.IO.Error (catchIOError, ioeSetErrorString, isPermissionError, mkIOError, permissionErrorType) import System.Win32.Types (failWith, getLastError) diff --git a/tests/Util.hs b/tests/Util.hs new file mode 100644 --- /dev/null +++ b/tests/Util.hs @@ -0,0 +1,165 @@ +{-# LANGUAGE BangPatterns, CPP #-} +module Util where +import Prelude (Eq(..), Num(..), Ord(..), RealFrac(..), Show(..), + Bool(..), Double, Either(..), Int, Integer, Maybe(..), String, + ($), (.), otherwise) +import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.List (elem, intercalate) +import Data.Monoid ((<>)) +import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime) +import Control.Concurrent (forkIO, killThread) +import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar) +import Control.Exception (SomeException, bracket_, catch, + mask, onException, try) +import Control.Monad (Monad(..), unless, when) +import System.Directory (createDirectory, makeAbsolute, + removeDirectoryRecursive, withCurrentDirectory) +import System.Exit (exitFailure) +import System.FilePath (FilePath, normalise) +import System.IO (IO, hFlush, hPutStrLn, putStrLn, stderr, stdout) +import System.IO.Error (IOError, isDoesNotExistError, + ioError, tryIOError, userError) +import System.Timeout (timeout) + +modifyIORef' :: IORef a -> (a -> a) -> IO () +modifyIORef' r f = do + x <- readIORef r + let !x' = f x in writeIORef r x' + +tryAny :: IO a -> IO (Either SomeException a) +tryAny action = do + result <- newEmptyMVar + mask $ \ unmask -> do + thread <- forkIO (try (unmask action) >>= putMVar result) + unmask (readMVar result) `onException` killThread thread + +timeLimit :: Double -> IO a -> IO a +timeLimit time action = do + result <- timeout (round (1000000 * time)) action + case result of + Nothing -> ioError (userError "timed out") + Just x -> return x + +data TestEnv = + TestEnv + { testCounter :: IORef Int + , testSilent :: Bool + , testKeepDirs :: Bool + } + +defaultTestEnv :: IORef Int -> TestEnv +defaultTestEnv counter = + TestEnv + { testCounter = counter + , testSilent = False + , testKeepDirs = False + } + +showSuccess :: TestEnv -> [String] -> IO () +showSuccess TestEnv{testSilent = True} _ = return () +showSuccess TestEnv{testSilent = False} msg = do + putStrLn (intercalate ": " msg) + hFlush stdout + +showFailure :: TestEnv -> [String] -> IO () +showFailure TestEnv{testCounter = n} msg = do + modifyIORef' n (+ 1) + hPutStrLn stderr ("*** " <> intercalate ": " msg) + hFlush stderr + +check :: TestEnv -> Bool -> [String] -> [String] -> [String] -> IO () +check t True prefix msg _ = showSuccess t (prefix <> msg) +check t False prefix _ msg = showFailure t (prefix <> msg) + +checkEither :: TestEnv -> [String] -> Either [String] [String] -> IO () +checkEither t prefix (Right msg) = showSuccess t (prefix <> msg) +checkEither t prefix (Left msg) = showFailure t (prefix <> msg) + +showContext :: Show a => String -> Integer -> a -> String +showContext file line context = + file <> ":" <> show line <> + case show context of + "()" -> "" + s -> ":" <> s + +expect :: Show a => TestEnv -> String -> Integer -> a -> Bool -> IO () +expect t file line context x = + check t x + [showContext file line context] + ["True"] + ["False, but True was expected"] + +expectEq :: (Eq a, Show a, Show b) => + TestEnv -> String -> Integer -> b -> a -> a -> IO () +expectEq t file line context x y = + check t (x == y) + [showContext file line context] + [show x <> " equals " <> show y] + [show x <> " is not equal to " <> show y] + +expectNear :: (Num a, Ord a, Show a, Show b) => + TestEnv -> String -> Integer -> b -> a -> a -> a -> IO () +expectNear t file line context x y diff = + check t (abs (x - y) <= diff) + [showContext file line context] + [show x <> " is near " <> show y] + [show x <> " is not near " <> show y] + +expectNearTime :: Show a => + TestEnv -> String -> Integer -> a -> + UTCTime -> UTCTime -> NominalDiffTime -> IO () +expectNearTime t file line context x y diff = + check t (abs (diffUTCTime x y) <= diff) + [showContext file line context] + [show x <> " is near " <> show y] + [show x <> " is not near " <> show y] + +expectIOErrorType :: Show a => + TestEnv -> String -> Integer -> a + -> (IOError -> Bool) -> IO b -> IO () +expectIOErrorType t file line context which action = do + result <- tryIOError action + checkEither t [showContext file line context] $ case result of + Left e | which e -> Right ["got expected exception (" <> show e <> ")"] + | otherwise -> Left ["got wrong exception: ", show e] + Right _ -> Left ["did not throw an exception"] + +withNewDirectory :: FilePath -> IO a -> IO a +withNewDirectory dir action = do + dir' <- makeAbsolute dir + bracket_ (createDirectory dir') + (removeDirectoryRecursive dir') action + +isolateWorkingDirectory :: FilePath -> IO a -> IO a +isolateWorkingDirectory dir action = do + when (normalise dir `elem` [".", "./"]) $ + ioError (userError ("isolateWorkingDirectory cannot be used " <> + "with current directory")) + dir' <- makeAbsolute dir + removeDirectoryRecursive dir' `catch` \ e -> + unless (isDoesNotExistError e) $ + ioError e + withNewDirectory dir' $ + withCurrentDirectory dir' $ + action + +run :: TestEnv -> String -> (TestEnv -> IO ()) -> IO () +run t name action = do + result <- tryAny (action t) + case result of + Left e -> check t False [name] [] ["exception", show e] + Right () -> return () + +isolatedRun :: TestEnv -> String -> (TestEnv -> IO ()) -> IO () +isolatedRun t name action = do + run t name (isolateWorkingDirectory ("test-" <> name <> ".tmp") . action) + +testMain :: (TestEnv -> IO ()) -> IO () +testMain action = do + counter <- newIORef 0 + action (defaultTestEnv counter) + n <- readIORef (counter) + unless (n == 0) $ do + putStrLn ("[" <> show n <> " failures]") + hFlush stdout + exitFailure diff --git a/tests/WithCurrentDirectory.hs b/tests/WithCurrentDirectory.hs new file mode 100644 --- /dev/null +++ b/tests/WithCurrentDirectory.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE CPP #-} +module WithCurrentDirectory where +#include "util.inl" +import Data.Monoid ((<>)) +import Data.List (sort) +import System.Directory +import System.FilePath (()) + +main :: TestEnv -> IO () +main _t = do + createDirectory dir + -- Make sure we're starting empty + T(expectEq) () specials . sort =<< getDirectoryContents dir + cwd <- getCurrentDirectory + withCurrentDirectory dir (writeFile testfile contents) + -- Are we still in original directory? + T(expectEq) () cwd =<< getCurrentDirectory + -- Did the test file get created? + T(expectEq) () (specials <> [testfile]) . sort =<< getDirectoryContents dir + -- Does the file contain what we expected to write? + T(expectEq) () contents =<< readFile (dir testfile) + where + testfile = "testfile" + contents = "some data\n" + dir = "dir" + specials = [".", ".."] diff --git a/tests/all.T b/tests/all.T deleted file mode 100644 --- a/tests/all.T +++ /dev/null @@ -1,32 +0,0 @@ -test('canonicalizePath001', normal, compile_and_run, ['']) -test('currentDirectory001', normal, compile_and_run, ['']) -test('directory001', normal, compile_and_run, ['']) -test('doesDirectoryExist001', normal, compile_and_run, ['']) - -# This test is a bit bogus. Disable for GHCi. -test('getDirContents001', omit_ways(['ghci']), compile_and_run, ['-fno-gen-manifest']) - -test('getDirContents002', [ normalise_exe, exit_code(1) ], - compile_and_run, ['']) - -# Depends on binary from previous run, which gets removed by the driver way=ghci -test('getPermissions001', omit_ways(['ghci']), compile_and_run, ['-cpp']) - -test('copyFile001', extra_clean(['copyFile001dir/target']), - compile_and_run, ['']) -test('copyFile002', extra_clean(['copyFile002dir/target']), - compile_and_run, ['']) - -test('renameFile001', extra_clean(['renameFile001.tmp1','renameFile001.tmp2']), - compile_and_run, ['']) - -test('createDirectory001', normal, compile_and_run, ['']) - -test('createDirectoryIfMissing001', normal, compile_and_run, ['']) - -# No sane way to tell whether the output is reasonable here... -test('getHomeDirectory001', ignore_output, compile_and_run, ['']) - -test('T8482', normal, compile_and_run, ['']) - -test('removeDirectoryRecursive001', normal, compile_and_run, ['']) diff --git a/tests/canonicalizePath001.hs b/tests/canonicalizePath001.hs deleted file mode 100644 --- a/tests/canonicalizePath001.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Main (main) where -import System.Directory -import System.IO.Error (catchIOError) - -main = do - dot <- canonicalizePath "." - nul <- canonicalizePath "" `catchIOError` \ _ -> return "" - print (dot == nul) diff --git a/tests/canonicalizePath001.stdout b/tests/canonicalizePath001.stdout deleted file mode 100644 --- a/tests/canonicalizePath001.stdout +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/copyFile001.hs b/tests/copyFile001.hs deleted file mode 100644 --- a/tests/copyFile001.hs +++ /dev/null @@ -1,26 +0,0 @@ - -module Main (main) where - -import Control.Exception -import Data.List -import System.Directory -import System.IO - -main :: IO () -main = do tryIO $ removeFile to - cs_before <- getDirectoryContents "copyFile001dir" - putStrLn "Before:" - print $ sort cs_before - copyFile from to - cs_before <- getDirectoryContents "copyFile001dir" - putStrLn "After:" - print $ sort cs_before - readFile to >>= print - -tryIO :: IO a -> IO (Either IOException a) -tryIO = try - -from, to :: FilePath -from = "copyFile001dir/source" -to = "copyFile001dir/target" - diff --git a/tests/copyFile001.stdout b/tests/copyFile001.stdout deleted file mode 100644 --- a/tests/copyFile001.stdout +++ /dev/null @@ -1,5 +0,0 @@ -Before: -[".","..","source"] -After: -[".","..","source","target"] -"This is the data" diff --git a/tests/copyFile001dir/source b/tests/copyFile001dir/source deleted file mode 100644 --- a/tests/copyFile001dir/source +++ /dev/null @@ -1,1 +0,0 @@ -This is the data diff --git a/tests/copyFile002.hs b/tests/copyFile002.hs deleted file mode 100644 --- a/tests/copyFile002.hs +++ /dev/null @@ -1,31 +0,0 @@ - -module Main (main) where - -import Control.Exception -import Data.List -import System.Directory -import System.IO - --- like copyFile001, but moves a file in the current directory --- See bug #1652 -main :: IO () -main = do d <- getCurrentDirectory - flip finally (setCurrentDirectory d) $ do - setCurrentDirectory "copyFile002dir" - tryIO $ removeFile to - cs_before <- getDirectoryContents "." - putStrLn "Before:" - print $ sort cs_before - copyFile from to - cs_before <- getDirectoryContents "." - putStrLn "After:" - print $ sort cs_before - readFile to >>= print - -tryIO :: IO a -> IO (Either IOException a) -tryIO = try - -from, to :: FilePath -from = "source" -to = "target" - diff --git a/tests/copyFile002.stdout b/tests/copyFile002.stdout deleted file mode 100644 --- a/tests/copyFile002.stdout +++ /dev/null @@ -1,5 +0,0 @@ -Before: -[".","..","source"] -After: -[".","..","source","target"] -"This is the data" diff --git a/tests/copyFile002dir/source b/tests/copyFile002dir/source deleted file mode 100644 --- a/tests/copyFile002dir/source +++ /dev/null @@ -1,1 +0,0 @@ -This is the data diff --git a/tests/createDirectory001.hs b/tests/createDirectory001.hs deleted file mode 100644 --- a/tests/createDirectory001.hs +++ /dev/null @@ -1,12 +0,0 @@ -import System.Directory -import Control.Exception - -testdir = "createDirectory001.dir" - -main = do - try (removeDirectory testdir) :: IO (Either IOException ()) - createDirectory testdir - r <- try $ createDirectory testdir - print (r :: Either IOException ()) -- already exists - removeDirectory testdir - diff --git a/tests/createDirectory001.stdout b/tests/createDirectory001.stdout deleted file mode 100644 --- a/tests/createDirectory001.stdout +++ /dev/null @@ -1,1 +0,0 @@ -Left createDirectory001.dir: createDirectory: already exists (File exists) diff --git a/tests/createDirectory001.stdout-mingw32 b/tests/createDirectory001.stdout-mingw32 deleted file mode 100644 --- a/tests/createDirectory001.stdout-mingw32 +++ /dev/null @@ -1,1 +0,0 @@ -Left CreateDirectory "createDirectory001.dir": already exists (Cannot create a file when that file already exists.) diff --git a/tests/createDirectoryIfMissing001.hs b/tests/createDirectoryIfMissing001.hs deleted file mode 100644 --- a/tests/createDirectoryIfMissing001.hs +++ /dev/null @@ -1,79 +0,0 @@ -module Main(main) where - -import Control.Concurrent -import Control.Monad -import Control.Exception as E -import System.Directory -import System.FilePath -import System.IO.Error - -testdir = "createDirectoryIfMissing001.d" -testdir_a = testdir "a" - -main = do - cleanup - - report $ createDirectoryIfMissing False testdir - cleanup - - report $ createDirectoryIfMissing False testdir_a - -- should fail with does not exist - - report $ createDirectoryIfMissing True testdir_a - -- should succeed with no error - report $ createDirectoryIfMissing False testdir_a - -- should succeed with no error - report $ createDirectoryIfMissing False (addTrailingPathSeparator testdir_a) - -- should succeed with no error - - cleanup - report $ createDirectoryIfMissing True (addTrailingPathSeparator testdir_a) - - -- look for race conditions: #2808. This fails with - -- +RTS -N2 and directory 1.0.0.2. - m <- newEmptyMVar - forkIO $ do replicateM_ 10000 create; putMVar m () - forkIO $ do replicateM_ 10000 cleanup; putMVar m () - replicateM_ 2 $ takeMVar m - --- This test fails on Windows; see #2924 --- replicateM_ 2 $ --- forkIO $ do replicateM_ 5000 (do create; cleanup); putMVar m () --- replicateM_ 2 $ takeMVar m - - cleanup - - -- these are all supposed to fail - - writeFile testdir testdir - report $ createDirectoryIfMissing False testdir - removeFile testdir - cleanup - - writeFile testdir testdir - report $ createDirectoryIfMissing True testdir_a - removeFile testdir - cleanup - --- createDirectoryIfMissing is allowed to fail with isDoesNotExistError if --- another process/thread removes one of the directories during the proces --- of creating the hierarchy. --- --- It is also allowed to fail with permission errors (see #2924) -create = tryJust (guard . (\e -> isDoesNotExistError e || isPermissionError e)) $ createDirectoryIfMissing True testdir_a - -cleanup = ignore $ removeDirectoryRecursive testdir - -report :: Show a => IO a -> IO () -report io = do - r <- E.try io - case r of - Left e -> print (e :: SomeException) - Right a -> print a - -ignore :: IO a -> IO () -ignore io = do - r <- E.try io - case r of - Left e -> let _ = e :: SomeException in return () - Right a -> return () diff --git a/tests/createDirectoryIfMissing001.stdout b/tests/createDirectoryIfMissing001.stdout deleted file mode 100644 --- a/tests/createDirectoryIfMissing001.stdout +++ /dev/null @@ -1,8 +0,0 @@ -() -createDirectoryIfMissing001.d/a: createDirectory: does not exist (No such file or directory) -() -() -() -() -createDirectoryIfMissing001.d: createDirectory: already exists (File exists) -createDirectoryIfMissing001.d/a: createDirectory: inappropriate type (Not a directory) diff --git a/tests/createDirectoryIfMissing001.stdout-mingw32 b/tests/createDirectoryIfMissing001.stdout-mingw32 deleted file mode 100644 --- a/tests/createDirectoryIfMissing001.stdout-mingw32 +++ /dev/null @@ -1,8 +0,0 @@ -() -CreateDirectory "createDirectoryIfMissing001.d\\a": does not exist (The system cannot find the path specified.) -() -() -() -() -CreateDirectory "createDirectoryIfMissing001.d": already exists (Cannot create a file when that file already exists.) -CreateDirectory "createDirectoryIfMissing001.d": already exists (Cannot create a file when that file already exists.) diff --git a/tests/currentDirectory001.hs b/tests/currentDirectory001.hs deleted file mode 100644 --- a/tests/currentDirectory001.hs +++ /dev/null @@ -1,27 +0,0 @@ - -import System.Directory (getCurrentDirectory, setCurrentDirectory, - createDirectory, removeDirectory, - getDirectoryContents) - -main :: IO () -main = do - oldpwd <- getCurrentDirectory - createDirectory dir - setCurrentDirectory dir - ~[n1, n2] <- getDirectoryContents "." - if dot n1 && dot n2 - then do - setCurrentDirectory oldpwd - removeDirectory dir - putStr "Okay\n" - else - ioError (userError "Oops") - -dot :: String -> Bool -dot "." = True -dot ".." = True -dot _ = False - -dir :: FilePath -dir = "currentDirectory001-dir" - diff --git a/tests/currentDirectory001.stdout b/tests/currentDirectory001.stdout deleted file mode 100644 --- a/tests/currentDirectory001.stdout +++ /dev/null @@ -1,1 +0,0 @@ -Okay diff --git a/tests/directory001.hs b/tests/directory001.hs deleted file mode 100644 --- a/tests/directory001.hs +++ /dev/null @@ -1,16 +0,0 @@ -import System.IO -import System.Directory - -main = do - createDirectory "foo" - h <- openFile "foo/bar" WriteMode - hPutStr h "Okay\n" - hClose h - renameFile "foo/bar" "foo/baz" - renameDirectory "foo" "bar" - h <- openFile "bar/baz" ReadMode - stuff <- hGetContents h - putStr stuff --- hClose h -- an error ! - removeFile "bar/baz" - removeDirectory "bar" diff --git a/tests/directory001.stdout b/tests/directory001.stdout deleted file mode 100644 --- a/tests/directory001.stdout +++ /dev/null @@ -1,1 +0,0 @@ -Okay diff --git a/tests/doesDirectoryExist001.hs b/tests/doesDirectoryExist001.hs deleted file mode 100644 --- a/tests/doesDirectoryExist001.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE CPP #-} --- !!! "/" was not recognised as a directory in 6.0.x -import System.Directory - -#ifdef mingw32_HOST_OS -root = "C:\\" -#else -root = "/" -#endif - -main = doesDirectoryExist root >>= print diff --git a/tests/doesDirectoryExist001.stdout b/tests/doesDirectoryExist001.stdout deleted file mode 100644 --- a/tests/doesDirectoryExist001.stdout +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/getDirContents001.hs b/tests/getDirContents001.hs deleted file mode 100644 --- a/tests/getDirContents001.hs +++ /dev/null @@ -1,18 +0,0 @@ -import System.Directory -import Control.Exception -import System.FilePath -import Data.List - -dir = "getDirContents001.dir" - -main = do - try cleanup :: IO (Either IOException ()) - bracket (createDirectory dir) (const cleanup) $ \_ -> do - getDirectoryContents dir >>= print . sort - mapM_ (\s -> writeFile (dir ('f':show s)) (show s)) [1..100] - getDirectoryContents dir >>= print . sort - -cleanup = do - files <- getDirectoryContents dir - mapM_ (removeFile . (dir )) (filter (not . ("." `isPrefixOf`)) files) - removeDirectory dir diff --git a/tests/getDirContents001.stdout b/tests/getDirContents001.stdout deleted file mode 100644 --- a/tests/getDirContents001.stdout +++ /dev/null @@ -1,2 +0,0 @@ -[".",".."] -[".","..","f1","f10","f100","f11","f12","f13","f14","f15","f16","f17","f18","f19","f2","f20","f21","f22","f23","f24","f25","f26","f27","f28","f29","f3","f30","f31","f32","f33","f34","f35","f36","f37","f38","f39","f4","f40","f41","f42","f43","f44","f45","f46","f47","f48","f49","f5","f50","f51","f52","f53","f54","f55","f56","f57","f58","f59","f6","f60","f61","f62","f63","f64","f65","f66","f67","f68","f69","f7","f70","f71","f72","f73","f74","f75","f76","f77","f78","f79","f8","f80","f81","f82","f83","f84","f85","f86","f87","f88","f89","f9","f90","f91","f92","f93","f94","f95","f96","f97","f98","f99"] diff --git a/tests/getDirContents002.hs b/tests/getDirContents002.hs deleted file mode 100644 --- a/tests/getDirContents002.hs +++ /dev/null @@ -1,3 +0,0 @@ -import System.Directory - -main = getDirectoryContents "nonexistent" diff --git a/tests/getDirContents002.stderr b/tests/getDirContents002.stderr deleted file mode 100644 --- a/tests/getDirContents002.stderr +++ /dev/null @@ -1,1 +0,0 @@ -getDirContents002: nonexistent: getDirectoryContents: does not exist (No such file or directory) diff --git a/tests/getDirContents002.stderr-mingw32 b/tests/getDirContents002.stderr-mingw32 deleted file mode 100644 --- a/tests/getDirContents002.stderr-mingw32 +++ /dev/null @@ -1,1 +0,0 @@ -getDirContents002.exe: nonexistent: getDirectoryContents: does not exist (The system cannot find the path specified.) diff --git a/tests/getHomeDirectory001.hs b/tests/getHomeDirectory001.hs deleted file mode 100644 --- a/tests/getHomeDirectory001.hs +++ /dev/null @@ -1,8 +0,0 @@ -import System.Directory - -main = do - getHomeDirectory >>= print - getAppUserDataDirectory "test" >>= print - getUserDocumentsDirectory >>= print - getTemporaryDirectory >>= print - return () diff --git a/tests/getPermissions001.hs b/tests/getPermissions001.hs deleted file mode 100644 --- a/tests/getPermissions001.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE CPP #-} -import System.Directory - -main = do -#ifdef mingw32_HOST_OS - let exe = ".exe" -#else - let exe = "" -#endif - p <- getPermissions "." - print p - p <- getPermissions "getPermissions001.hs" - print p - p <- getPermissions ("getPermissions001" ++ exe) - print p - - -- issue #9: Windows doesn't like trailing path separators - _ <- getPermissions "../tests/" - - return () diff --git a/tests/getPermissions001.stdout b/tests/getPermissions001.stdout deleted file mode 100644 --- a/tests/getPermissions001.stdout +++ /dev/null @@ -1,3 +0,0 @@ -Permissions {readable = True, writable = True, executable = False, searchable = True} -Permissions {readable = True, writable = True, executable = False, searchable = False} -Permissions {readable = True, writable = True, executable = True, searchable = False} diff --git a/tests/getPermissions001.stdout-alpha-dec-osf3 b/tests/getPermissions001.stdout-alpha-dec-osf3 deleted file mode 100644 --- a/tests/getPermissions001.stdout-alpha-dec-osf3 +++ /dev/null @@ -1,3 +0,0 @@ -Permissions {readable = True, writable = True, executable = False, searchable = True} -Permissions {readable = True, writable = True, executable = False, searchable = False} -Permissions {readable = True, writable = False, executable = True, searchable = False} diff --git a/tests/getPermissions001.stdout-i386-unknown-freebsd b/tests/getPermissions001.stdout-i386-unknown-freebsd deleted file mode 100644 --- a/tests/getPermissions001.stdout-i386-unknown-freebsd +++ /dev/null @@ -1,3 +0,0 @@ -Permissions {readable = True, writable = True, executable = False, searchable = True} -Permissions {readable = True, writable = True, executable = False, searchable = False} -Permissions {readable = True, writable = False, executable = True, searchable = False} diff --git a/tests/getPermissions001.stdout-i386-unknown-openbsd b/tests/getPermissions001.stdout-i386-unknown-openbsd deleted file mode 100644 --- a/tests/getPermissions001.stdout-i386-unknown-openbsd +++ /dev/null @@ -1,3 +0,0 @@ -Permissions {readable = True, writable = True, executable = False, searchable = True} -Permissions {readable = True, writable = True, executable = False, searchable = False} -Permissions {readable = True, writable = False, executable = True, searchable = False} diff --git a/tests/getPermissions001.stdout-mingw b/tests/getPermissions001.stdout-mingw deleted file mode 100644 --- a/tests/getPermissions001.stdout-mingw +++ /dev/null @@ -1,3 +0,0 @@ -Permissions {readable = True, writable = True, executable = True, searchable = True} -Permissions {readable = True, writable = True, executable = True, searchable = True} -Permissions {readable = True, writable = True, executable = True, searchable = True} diff --git a/tests/getPermissions001.stdout-x86_64-unknown-openbsd b/tests/getPermissions001.stdout-x86_64-unknown-openbsd deleted file mode 100644 --- a/tests/getPermissions001.stdout-x86_64-unknown-openbsd +++ /dev/null @@ -1,3 +0,0 @@ -Permissions {readable = True, writable = True, executable = False, searchable = True} -Permissions {readable = True, writable = True, executable = False, searchable = False} -Permissions {readable = True, writable = False, executable = True, searchable = False} diff --git a/tests/removeDirectoryRecursive001.hs b/tests/removeDirectoryRecursive001.hs deleted file mode 100644 --- a/tests/removeDirectoryRecursive001.hs +++ /dev/null @@ -1,93 +0,0 @@ -{-# LANGUAGE CPP #-} -module Main (main) where -import Data.List (sort) -import System.Directory -import System.FilePath ((), normalise) -import System.IO.Error (catchIOError) -import TestUtils - -testName :: String -testName = "removeDirectoryRecursive001" - -tmpD :: String -tmpD = testName ++ ".tmp" - -tmp :: String -> String -tmp s = tmpD normalise s - -main :: IO () -main = do - - ------------------------------------------------------------ - -- clean up junk from previous invocations - - modifyPermissions (tmp "c") (\ p -> p { writable = True }) - `catchIOError` \ _ -> return () - removeDirectoryRecursive tmpD - `catchIOError` \ _ -> return () - - ------------------------------------------------------------ - -- set up - - createDirectoryIfMissing True (tmp "a/x/w") - createDirectoryIfMissing True (tmp "a/y") - createDirectoryIfMissing True (tmp "a/z") - createDirectoryIfMissing True (tmp "b") - createDirectoryIfMissing True (tmp "c") - writeFile (tmp "a/x/w/u") "foo" - writeFile (tmp "a/t") "bar" - tryCreateSymbolicLink (normalise "../a") (tmp "b/g") - tryCreateSymbolicLink (normalise "../b") (tmp "c/h") - tryCreateSymbolicLink (normalise "a") (tmp "d") - modifyPermissions (tmp "c") (\ p -> p { writable = False }) - - ------------------------------------------------------------ - -- tests - - getDirectoryContents tmpD >>= putStrLn . unwords . sort - getDirectoryContents (tmp "a") >>= putStrLn . unwords . sort - getDirectoryContents (tmp "b") >>= putStrLn . unwords . sort - getDirectoryContents (tmp "c") >>= putStrLn . unwords . sort - getDirectoryContents (tmp "d") >>= putStrLn . unwords . sort - - putStrLn "" - - removeDirectoryRecursive (tmp "d") - `catchIOError` \ _ -> removeFile (tmp "d") -#ifdef mingw32_HOST_OS - `catchIOError` \ _ -> removeDirectory (tmp "d") -#endif - - getDirectoryContents tmpD >>= putStrLn . unwords . sort - getDirectoryContents (tmp "a") >>= putStrLn . unwords . sort - getDirectoryContents (tmp "b") >>= putStrLn . unwords . sort - getDirectoryContents (tmp "c") >>= putStrLn . unwords . sort - - putStrLn "" - - removeDirectoryRecursive (tmp "c") - `catchIOError` \ _ -> do - modifyPermissions (tmp "c") (\ p -> p { writable = True }) - removeDirectoryRecursive (tmp "c") - - getDirectoryContents tmpD >>= putStrLn . unwords . sort - getDirectoryContents (tmp "a") >>= putStrLn . unwords . sort - getDirectoryContents (tmp "b") >>= putStrLn . unwords . sort - - putStrLn "" - - removeDirectoryRecursive (tmp "b") - - getDirectoryContents tmpD >>= putStrLn . unwords . sort - getDirectoryContents (tmp "a") >>= putStrLn . unwords . sort - - putStrLn "" - - removeDirectoryRecursive (tmp "a") - - getDirectoryContents tmpD >>= putStrLn . unwords . sort - - ------------------------------------------------------------ - -- clean up - - removeDirectoryRecursive tmpD diff --git a/tests/removeDirectoryRecursive001.stdout b/tests/removeDirectoryRecursive001.stdout deleted file mode 100644 --- a/tests/removeDirectoryRecursive001.stdout +++ /dev/null @@ -1,19 +0,0 @@ -. .. a b c d -. .. t x y z -. .. g -. .. h -. .. t x y z - -. .. a b c -. .. t x y z -. .. g -. .. h - -. .. a b -. .. t x y z -. .. g - -. .. a -. .. t x y z - -. .. diff --git a/tests/renameFile001.hs b/tests/renameFile001.hs deleted file mode 100644 --- a/tests/renameFile001.hs +++ /dev/null @@ -1,13 +0,0 @@ -import System.Directory - -tmp1 = "renameFile001.tmp1" -tmp2 = "renameFile001.tmp2" - -main = do - writeFile tmp1 "test" - renameFile tmp1 tmp2 - readFile tmp2 >>= print - writeFile tmp1 "test2" - renameFile tmp2 tmp1 - readFile tmp1 >>= print - diff --git a/tests/renameFile001.stdout b/tests/renameFile001.stdout deleted file mode 100644 --- a/tests/renameFile001.stdout +++ /dev/null @@ -1,2 +0,0 @@ -"test" -"test" diff --git a/tests/util.inl b/tests/util.inl new file mode 100644 --- /dev/null +++ b/tests/util.inl @@ -0,0 +1,4 @@ +#define T(expect) (T./**/expect _t __FILE__ __LINE__) + +import Util (TestEnv) +import qualified Util as T diff --git a/tools/dispatch-tests.hs b/tools/dispatch-tests.hs deleted file mode 100644 --- a/tools/dispatch-tests.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE CPP, ForeignFunctionInterface #-} -module Main (main) where -import Prelude (($), (.), (=<<), (==), Eq, IO, Int, String, - id, fromIntegral, otherwise, unwords) -import Data.Functor ((<$>)) -import Data.Monoid ((<>), mconcat) -import Foreign (Ptr) -import Foreign.C (CChar(..), CInt(..), withCString) -import System.Directory () -- to ensure `directory` is built beforehand -import System.Environment (getArgs) -import System.Exit (ExitCode(ExitSuccess, ExitFailure), exitWith) - -main :: IO () -main = do - - -- check if 'cabal exec' is supported (didn't exist until 1.20) - cabalExecTest <- rawSystem "sh" ["-c", "cabal >/dev/null 2>&1 exec true"] - - -- execute in the Cabal sandbox environment if possible - let prefix = case cabalExecTest of - ExitSuccess -> ["cabal", "exec", "--"] - ExitFailure _ -> [] - - args <- getArgs - let command : arguments = prefix <> ["sh", "tools/run-tests"] <> args - exitWith =<< normalizeExitCode <$> rawSystem command arguments - -makeExitCode :: Int -> ExitCode -makeExitCode 0 = ExitSuccess -makeExitCode e = ExitFailure e - --- on Linux the exit code is right-shifted by 8 bits, causing exit codes to be --- rather large; older versions of GHC don't seem to handle that well in --- `exitWith` -normalizeExitCode :: ExitCode -> ExitCode -normalizeExitCode ExitSuccess = ExitSuccess -normalizeExitCode (ExitFailure _) = ExitFailure 1 - --- we can't use the `process` library as it causes a dependency cycle with --- Cabal, so we reinvent the wheel here in a simplistic way; this will --- probably break with non-ASCII characters on Windows -rawSystem :: String -> [String] -> IO ExitCode -rawSystem cmd args = - withCString (quoteCmdArgs (cmd : args)) $ \ c_command -> - makeExitCode . fromIntegral <$> c_system c_command - --- handle the different quoting rules in CMD.EXE vs POSIX shells -quoteCmdArgs :: [String] -> String -quoteCmdArgs cmdArgs = -#ifdef mingw32_HOST_OS - -- the arcane quoting rules require us to add an extra set of quotes - -- around the entire thing: see `help cmd` or look at - -- https://superuser.com/a/238813 - let quote s = "\"" <> replaceElem '"' "\"\"" s <> "\"" - in (\ s -> "\"" <> s <> "\"") $ -#else - let quote s = "'" <> replaceElem '\'' "'\\''" s <> "'" - in id $ -#endif - unwords (quote <$> cmdArgs) - -replaceElem :: Eq a => a -> [a] -> [a] -> [a] -replaceElem match repl = mconcat . (replace <$>) - where replace c | c == match = repl - | otherwise = [c] - -foreign import ccall safe "stdlib.h system" c_system :: Ptr CChar -> IO CInt diff --git a/tools/ghc-test-framework.LICENSE b/tools/ghc-test-framework.LICENSE deleted file mode 100644 --- a/tools/ghc-test-framework.LICENSE +++ /dev/null @@ -1,44 +0,0 @@ -The Glasgow Haskell Compiler License - -Copyright 2002, The University Court of the University of Glasgow. -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -- Redistributions of source code must retain the above copyright notice, -this list of conditions and the following disclaimer. - -- Redistributions in binary form must reproduce the above copyright notice, -this list of conditions and the following disclaimer in the documentation -and/or other materials provided with the distribution. - -- Neither name of the University nor the names of its contributors may be -used to endorse or promote products derived from this software without -specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF -GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, -INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. - -================================================================================ -The GHC testsuite contains several files under different licenses, explained -here: - - The following tests are under the GPLv3, or (at your option) any later version: - - - tests/indexed-types/should_compile/T3787.hs - - tests/typecheck/should_compile/T4524.hs - - tests/simplCore/should_run/T3591.hs - - You should have received a copy of the GNU General Public License along with - the GHC testsuite, in LICENSE.GPL diff --git a/tools/ghc-test-framework.shar b/tools/ghc-test-framework.shar deleted file mode 100644 --- a/tools/ghc-test-framework.shar +++ /dev/null @@ -1,4253 +0,0 @@ -#!/bin/sh -# from ghc commit 6b96eeb72a17e35c59830952732170d29d99a598 - -mkdir -p 'ghc-test-framework/config' -sed "s/^ //" <<"EOF" >'ghc-test-framework/config/bad.ps' - This is a bad postscript file -EOF -chmod 644 'ghc-test-framework/config/bad.ps' - -mkdir -p 'ghc-test-framework/config' -sed "s/^ //" <<"EOF" >'ghc-test-framework/config/ghc' - import os - import re - - # Testsuite configuration setup for GHC - # - # This file is Python source - # - config.compiler_type = 'ghc' - config.compiler = 'ghc' - config.compiler_always_flags = ghc_compiler_always_flags.split() - - config.hp2ps = 'hp2ps' - config.hpc = 'hpc' - config.gs = 'gs' - config.confdir = '.' - - # By default, the 'normal' and 'hpc' ways are enabled. In addition, certain - # ways are enabled automatically if this GHC supports them. Ways that fall in - # this group are 'optasm', 'optllvm', 'profasm', 'threaded1', 'threaded2', - # 'profthreaded', 'ghci', and whichever of 'static/dyn' is not this GHC's - # default mode. Other ways should be set explicitly from .T files. - config.compile_ways = ['normal', 'hpc'] - config.run_ways = ['normal', 'hpc'] - - # ways that are not enabled by default, but can always be invoked explicitly - config.other_ways = ['prof', - 'prof_hc_hb','prof_hb', - 'prof_hd','prof_hy','prof_hr', - 'threaded1_ls', 'threaded2_hT', - 'llvm', 'debugllvm', - 'profllvm', 'profoptllvm', 'profthreadedllvm', - 'debug'] - - if (ghc_with_native_codegen == 1): - config.compile_ways.append('optasm') - config.run_ways.append('optasm') - - config.compiler_debugged = ghc_debugged - - if (ghc_with_vanilla == 1): - config.have_vanilla = True - - if (ghc_with_dynamic == 1): - config.have_dynamic = True - - if (ghc_with_profiling == 1): - config.have_profiling = True - config.compile_ways.append('profasm') - config.run_ways.append('profasm') - - if (ghc_with_interpreter == 1): - config.have_interp = True - config.run_ways.append('ghci') - - config.unregisterised = (ghc_unregisterised == 1) - - if (ghc_with_threaded_rts == 1): - config.run_ways.append('threaded1') - if (ghc_with_smp == 1): - config.have_smp = True - config.run_ways.append('threaded2') - - if (ghc_with_dynamic_rts == 1): - config.have_shared_libs = True - - config.ghc_dynamic_by_default = ghc_dynamic_by_default - if ghc_dynamic_by_default and ghc_with_vanilla == 1: - config.run_ways.append('static') - else: - if (ghc_with_dynamic_rts == 1): - config.run_ways.append('dyn') - - config.ghc_dynamic = ghc_dynamic - - if (ghc_with_profiling == 1 and ghc_with_threaded_rts == 1): - config.run_ways.append('profthreaded') - - if (ghc_with_llvm == 1): - config.compile_ways.append('optllvm') - config.run_ways.append('optllvm') - - config.in_tree_compiler = in_tree_compiler - config.clean_only = clean_only - - config.way_flags = lambda name : { - 'normal' : [], - 'g1' : [], - 'optasm' : ['-O', '-fasm'], - 'llvm' : ['-fllvm'], - 'optllvm' : ['-O', '-fllvm'], - 'debugllvm' : ['-fllvm', '-keep-llvm-files'], - 'prof' : ['-prof', '-static', '-auto-all', '-fasm'], - 'profasm' : ['-O', '-prof', '-static', '-auto-all'], - 'profthreaded' : ['-O', '-prof', '-static', '-auto-all', '-threaded'], - 'ghci' : ['--interactive', '-v0', '-ignore-dot-ghci', '+RTS', '-I0.1', '-RTS'], - 'threaded1' : ['-threaded', '-debug'], - 'threaded1_ls' : ['-threaded', '-debug'], - 'threaded2' : ['-O', '-threaded', '-eventlog'], - 'threaded2_hT' : ['-O', '-threaded'], - 'hpc' : ['-O', '-fhpc', '-hpcdir', '.hpc.' + name ], - 'prof_hc_hb' : ['-O', '-prof', '-static', '-auto-all'], - 'prof_hb' : ['-O', '-prof', '-static', '-auto-all'], - 'prof_hd' : ['-O', '-prof', '-static', '-auto-all'], - 'prof_hy' : ['-O', '-prof', '-static', '-auto-all'], - 'prof_hr' : ['-O', '-prof', '-static', '-auto-all'], - 'dyn' : ['-O', '-dynamic'], - 'static' : ['-O', '-static'], - 'debug' : ['-O', '-g', '-dannot-lint'], - # llvm variants... - 'profllvm' : ['-prof', '-static', '-auto-all', '-fllvm'], - 'profoptllvm' : ['-O', '-prof', '-static', '-auto-all', '-fllvm'], - 'profthreadedllvm' : ['-O', '-prof', '-static', '-auto-all', '-threaded', '-fllvm'], - } - - config.way_rts_flags = { - 'normal' : [], - 'g1' : ['-G1'], - 'optasm' : [], - 'llvm' : [], - 'optllvm' : [], - 'debugllvm' : [], - 'prof' : ['-p'], - 'profasm' : ['-hc', '-p'], # test heap profiling too - 'profthreaded' : ['-p'], - 'ghci' : [], - 'threaded1' : [], - 'threaded1_ls' : ['-ls'], - 'threaded2' : ['-N2 -ls'], - 'threaded2_hT' : ['-N2', '-hT'], - 'hpc' : [], - 'prof_hc_hb' : ['-hc -hbvoid'], - 'prof_hb' : ['-hb'], - 'prof_hd' : ['-hd'], - 'prof_hy' : ['-hy'], - 'prof_hr' : ['-hr'], - 'dyn' : [], - 'static' : [], - 'debug' : [], - # llvm variants... - 'profllvm' : ['-p'], - 'profoptllvm' : ['-hc', '-p'], - 'profthreadedllvm' : ['-p'], - } - - # Useful classes of ways that can be used with only_ways() and - # expect_broken_for(). - - prof_ways = [x[0] for x in config.way_flags('dummy_name').items() - if '-prof' in x[1]] - - threaded_ways = [x[0] for x in config.way_flags('dummy_name').items() - if '-threaded' in x[1] or 'ghci' == x[0]] - - opt_ways = [x[0] for x in config.way_flags('dummy_name').items() - if '-O' in x[1]] - - llvm_ways = [x[0] for x in config.way_flags('dummy_name').items() - if '-fflvm' in x[1]] - - def get_compiler_info(): - # This should really not go through the shell - h = os.popen(config.compiler + ' --info', 'r') - s = h.read() - s = re.sub('[\r\n]', '', s) - h.close() - compilerInfoDict = dict(eval(s)) - h = os.popen(config.compiler + ' +RTS --info', 'r') - s = h.read() - s = re.sub('[\r\n]', '', s) - h.close() - rtsInfoDict = dict(eval(s)) - - # We use a '/'-separated path for libdir, even on Windows - config.libdir = re.sub('\\\\','/',compilerInfoDict['LibDir']) - - v = compilerInfoDict["Project version"].split('-') - config.compiler_version = v[0] - config.compiler_maj_version = re.sub('^([0-9]+\.[0-9]+).*',r'\1', v[0]) - config.compiler_tags = v[1:] - - # -fno-ghci-history was added in 7.3 - if version_ge(config.compiler_version, '7.3'): - config.compiler_always_flags = \ - config.compiler_always_flags + ['-fno-ghci-history'] - - if re.match(".*_p(_.*|$)", rtsInfoDict["RTS way"]): - config.compiler_profiled = True - config.run_ways = [x for x in config.run_ways if x != 'ghci'] - else: - config.compiler_profiled = False - - try: - config.package_conf_cache_file = compilerInfoDict["Global Package DB"] + '/package.cache' - except: - config.package_conf_cache_file = '' - - try: - if compilerInfoDict["GHC Dynamic"] == "YES": - ghcDynamic = True - elif compilerInfoDict["GHC Dynamic"] == "NO": - ghcDynamic = False - else: - raise 'Bad value for "GHC Dynamic"' - except KeyError: - # GHC < 7.7 doesn't have a "GHC Dynamic" field - ghcDynamic = False - - if ghcDynamic: - config.ghc_th_way_flags = "-dynamic" - config.ghci_way_flags = "-dynamic" - config.ghc_th_way = "dyn" - config.ghc_plugin_way = "dyn" - else: - config.ghc_th_way_flags = "-static" - config.ghci_way_flags = "-static" - config.ghc_th_way = "normal" - config.ghc_plugin_way = "normal" - -EOF -chmod 644 'ghc-test-framework/config/ghc' - -mkdir -p 'ghc-test-framework/config' -sed "s/^ //" <<"EOF" >'ghc-test-framework/config/good.ps' - % this is a good postscript file -EOF -chmod 644 'ghc-test-framework/config/good.ps' - -mkdir -p 'ghc-test-framework/driver' -sed "s/^ //" <<"EOF" >'ghc-test-framework/driver/runtests.py' - # - # (c) Simon Marlow 2002 - # - - from __future__ import print_function - - import sys - import os - import string - import getopt - import platform - import time - import re - - # We don't actually need subprocess in runtests.py, but: - # * We do need it in testlibs.py - # * We can't import testlibs.py until after we have imported ctypes - # * If we import ctypes before subprocess on cygwin, then sys.exit(0) - # says "Aborted" and we fail with exit code 134. - # So we import it here first, so that the testsuite doesn't appear to fail. - try: - import subprocess - except: - pass - - PYTHON3 = sys.version_info >= (3, 0) - if PYTHON3: - print("*** WARNING: running testsuite using Python 3.\n" - "*** Python 3 support is experimental. See Trac #9184.") - - from testutil import * - from testglobals import * - - # Readline sometimes spews out ANSI escapes for some values of TERM, - # which result in test failures. Thus set TERM to a nice, simple, safe - # value. - os.environ['TERM'] = 'vt100' - - global config - config = getConfig() # get it from testglobals - - # ----------------------------------------------------------------------------- - # cmd-line options - - long_options = [ - "config=", # config file - "rootdir=", # root of tree containing tests (default: .) - "output-summary=", # file in which to save the (human-readable) summary - "only=", # just this test (can be give multiple --only= flags) - "way=", # just this way - "skipway=", # skip this way - "threads=", # threads to run simultaneously - "check-files-written", # check files aren't written by multiple tests - "verbose=", # verbose (0,1,2 so far) - "skip-perf-tests", # skip performance tests - ] - - opts, args = getopt.getopt(sys.argv[1:], "e:", long_options) - - for opt,arg in opts: - if opt == '--config': - exec(open(arg).read()) - - # -e is a string to execute from the command line. For example: - # testframe -e 'config.compiler=ghc-5.04' - if opt == '-e': - exec(arg) - - if opt == '--rootdir': - config.rootdirs.append(arg) - - if opt == '--output-summary': - config.output_summary = arg - - if opt == '--only': - config.only.append(arg) - - if opt == '--way': - if (arg not in config.run_ways and arg not in config.compile_ways and arg not in config.other_ways): - sys.stderr.write("ERROR: requested way \'" + - arg + "\' does not exist\n") - sys.exit(1) - config.cmdline_ways = [arg] + config.cmdline_ways - if (arg in config.other_ways): - config.run_ways = [arg] + config.run_ways - config.compile_ways = [arg] + config.compile_ways - - if opt == '--skipway': - if (arg not in config.run_ways and arg not in config.compile_ways and arg not in config.other_ways): - sys.stderr.write("ERROR: requested way \'" + - arg + "\' does not exist\n") - sys.exit(1) - config.other_ways = [w for w in config.other_ways if w != arg] - config.run_ways = [w for w in config.run_ways if w != arg] - config.compile_ways = [w for w in config.compile_ways if w != arg] - - if opt == '--threads': - config.threads = int(arg) - config.use_threads = 1 - - if opt == '--check-files-written': - config.check_files_written = True - - if opt == '--skip-perf-tests': - config.skip_perf_tests = True - - if opt == '--verbose': - if arg not in ["0","1","2","3","4"]: - sys.stderr.write("ERROR: requested verbosity %s not supported, use 0,1,2,3 or 4" % arg) - sys.exit(1) - config.verbose = int(arg) - - - if config.use_threads == 1: - # Trac #1558 says threads don't work in python 2.4.4, but do - # in 2.5.2. Probably >= 2.5 is sufficient, but let's be - # conservative here. - # Some versions of python have things like '1c1' for some of - # these components (see trac #3091), but int() chokes on the - # 'c1', so we drop it. - (maj, min, pat) = platform.python_version_tuple() - # We wrap maj, min, and pat in str() to work around a bug in python - # 2.6.1 - maj = int(re.sub('[^0-9].*', '', str(maj))) - min = int(re.sub('[^0-9].*', '', str(min))) - pat = int(re.sub('[^0-9].*', '', str(pat))) - if (maj, min) < (2, 6): - print("Python < 2.6 is not supported") - sys.exit(1) - # We also need to disable threads for python 2.7.2, because of - # this bug: http://bugs.python.org/issue13817 - elif (maj, min, pat) == (2, 7, 2): - print("Warning: Ignoring request to use threads as python version is 2.7.2") - print("See http://bugs.python.org/issue13817 for details.") - config.use_threads = 0 - if windows: - print("Warning: Ignoring request to use threads as running on Windows") - config.use_threads = 0 - - config.cygwin = False - config.msys = False - - if windows: - h = os.popen('uname -s', 'r') - v = h.read() - h.close() - if v.startswith("CYGWIN"): - config.cygwin = True - elif v.startswith("MINGW") or v.startswith("MSYS"): - # msys gives "MINGW32" - # msys2 gives "MINGW_NT-6.2" or "MSYS_NT-6.3" - config.msys = True - else: - raise Exception("Can't detect Windows terminal type") - - # Try to use UTF8 - if windows: - import ctypes - # Windows Python provides windll, mingw python provides cdll. - if hasattr(ctypes, 'windll'): - mydll = ctypes.windll - else: - mydll = ctypes.cdll - - # This actually leaves the terminal in codepage 65001 (UTF8) even - # after python terminates. We ought really remember the old codepage - # and set it back. - if mydll.kernel32.SetConsoleCP(65001) == 0: - raise Exception("Failure calling SetConsoleCP(65001)") - if mydll.kernel32.SetConsoleOutputCP(65001) == 0: - raise Exception("Failure calling SetConsoleOutputCP(65001)") - else: - # Try and find a utf8 locale to use - # First see if we already have a UTF8 locale - h = os.popen('locale | grep LC_CTYPE | grep -i utf', 'r') - v = h.read() - h.close() - if v == '': - # We don't, so now see if 'locale -a' works - h = os.popen('locale -a', 'r') - v = h.read() - h.close() - if v != '': - # If it does then use the first utf8 locale that is available - h = os.popen('locale -a | grep -i "utf8\|utf-8" 2>/dev/null', 'r') - v = h.readline().strip() - h.close() - if v != '': - os.environ['LC_ALL'] = v - print("setting LC_ALL to", v) - else: - print('WARNING: No UTF8 locale found.') - print('You may get some spurious test failures.') - - # This has to come after arg parsing as the args can change the compiler - get_compiler_info() - - # Can't import this earlier as we need to know if threading will be - # enabled or not - from testlib import * - - # On Windows we need to set $PATH to include the paths to all the DLLs - # in order for the dynamic library tests to work. - if windows or darwin: - pkginfo = getStdout([config.ghc_pkg, 'dump']) - topdir = config.libdir - for line in pkginfo.split('\n'): - if line.startswith('library-dirs:'): - path = line.rstrip() - path = re.sub('^library-dirs: ', '', path) - path = re.sub('\\$topdir', topdir, path) - if path.startswith('"'): - path = re.sub('^"(.*)"$', '\\1', path) - path = re.sub('\\\\(.)', '\\1', path) - if windows: - if config.cygwin: - # On cygwin we can't put "c:\foo" in $PATH, as : is a - # field separator. So convert to /cygdrive/c/foo instead. - # Other pythons use ; as the separator, so no problem. - path = re.sub('([a-zA-Z]):', '/cygdrive/\\1', path) - path = re.sub('\\\\', '/', path) - os.environ['PATH'] = os.pathsep.join([path, os.environ.get("PATH", "")]) - else: - # darwin - os.environ['DYLD_LIBRARY_PATH'] = os.pathsep.join([path, os.environ.get("DYLD_LIBRARY_PATH", "")]) - - global testopts_local - testopts_local.x = TestOptions() - - if config.use_threads: - t.lock = threading.Lock() - t.thread_pool = threading.Condition(t.lock) - t.lockFilesWritten = threading.Lock() - t.running_threads = 0 - - # if timeout == -1 then we try to calculate a sensible value - if config.timeout == -1: - config.timeout = int(read_no_crs(config.top + '/timeout/calibrate.out')) - - print('Timeout is ' + str(config.timeout)) - - # ----------------------------------------------------------------------------- - # The main dude - - if config.rootdirs == []: - config.rootdirs = ['.'] - - t_files = findTFiles(config.rootdirs) - - print('Found', len(t_files), '.T files...') - - t = getTestRun() - - # Avoid cmd.exe built-in 'date' command on Windows - t.start_time = time.localtime() - - print('Beginning test run at', time.strftime("%c %Z",t.start_time)) - - sys.stdout.flush() - if PYTHON3: - # in Python 3, we output text, which cannot be unbuffered - sys.stdout = os.fdopen(sys.__stdout__.fileno(), "w") - else: - # set stdout to unbuffered (is this the best way to do it?) - sys.stdout = os.fdopen(sys.__stdout__.fileno(), "w", 0) - - # First collect all the tests to be run - for file in t_files: - if_verbose(2, '====> Scanning %s' % file) - newTestDir(os.path.dirname(file)) - try: - exec(open(file).read()) - except Exception: - print('*** framework failure: found an error while executing ', file, ':') - t.n_framework_failures = t.n_framework_failures + 1 - traceback.print_exc() - - if config.list_broken: - global brokens - print('') - print('Broken tests:') - print(' '.join(map (lambda bdn: '#' + str(bdn[0]) + '(' + bdn[1] + '/' + bdn[2] + ')', brokens))) - print('') - - if t.n_framework_failures != 0: - print('WARNING:', str(t.n_framework_failures), 'framework failures!') - print('') - else: - # Now run all the tests - if config.use_threads: - t.running_threads=0 - for oneTest in parallelTests: - if stopping(): - break - oneTest() - if config.use_threads: - t.thread_pool.acquire() - while t.running_threads>0: - t.thread_pool.wait() - t.thread_pool.release() - config.use_threads = False - for oneTest in aloneTests: - if stopping(): - break - oneTest() - - summary(t, sys.stdout) - - if config.output_summary != '': - summary(t, open(config.output_summary, 'w')) - - sys.exit(0) - -EOF -chmod 644 'ghc-test-framework/driver/runtests.py' - -mkdir -p 'ghc-test-framework/driver' -sed "s/^ //" <<"EOF" >'ghc-test-framework/driver/testglobals.py' - # - # (c) Simon Marlow 2002 - # - - # ----------------------------------------------------------------------------- - # Configuration info - - # There is a single global instance of this structure, stored in the - # variable config below. The fields of the structure are filled in by - # the appropriate config script(s) for this compiler/platform, in - # ../config. - # - # Bits of the structure may also be filled in from the command line, - # via the build system, using the '-e' option to runtests. - - class TestConfig: - def __init__(self): - - # Where the testsuite root is - self.top = '' - - # Directories below which to look for test description files (foo.T) - self.rootdirs = [] - - # Run these tests only (run all tests if empty) - self.only = [] - - # Accept new output which differs from the sample? - self.accept = 0 - - # File in which to save the summary - self.output_summary = '' - - # File in which to save the times - self.times_file = '' - - # What platform are we running on? - self.platform = '' - self.os = '' - self.arch = '' - - # What is the wordsize (in bits) of this platform? - self.wordsize = '' - - # Verbosity level - self.verbose = 3 - - # run the "fast" version of the test suite - self.fast = 0 - - self.list_broken = False - - # Compiler type (ghc, hugs, nhc, etc.) - self.compiler_type = '' - - # Path to the compiler - self.compiler = '' - # and ghc-pkg - self.ghc_pkg = '' - - # Compiler version info - self.compiler_version = '' - self.compiler_maj_version = '' - self.compiler_tags = [] - - # Flags we always give to this compiler - self.compiler_always_flags = [] - - # Which ways to run tests (when compiling and running respectively) - # Other ways are added from the command line if we have the appropriate - # libraries. - self.compile_ways = [] - self.run_ways = [] - self.other_ways = [] - - # The ways selected via the command line. - self.cmdline_ways = [] - - # Lists of flags for each way - self.way_flags = {} - self.way_rts_flags = {} - - # Do we have vanilla libraries? - self.have_vanilla = False - - # Do we have dynamic libraries? - self.have_dynamic = False - - # Do we have profiling support? - self.have_profiling = False - - # Do we have interpreter support? - self.have_interp = False - - # Do we have shared libraries? - self.have_shared_libs = False - - # Do we have SMP support? - self.have_smp = False - - # Are we testing an in-tree compiler? - self.in_tree_compiler = True - - # the timeout program - self.timeout_prog = '' - self.timeout = 300 - - # threads - self.threads = 1 - self.use_threads = 0 - - # Should we check for files being written more than once? - self.check_files_written = False - - # Should we skip performance tests - self.skip_perf_tests = False - - global config - config = TestConfig() - - def getConfig(): - return config - - # ----------------------------------------------------------------------------- - # Information about the current test run - - class TestRun: - def __init__(self): - self.start_time = None - self.total_tests = 0 - self.total_test_cases = 0 - self.n_framework_failures = 0 - self.framework_failures = {} - self.n_tests_skipped = 0 - self.tests_skipped = {} - self.n_expected_passes = 0 - self.expected_passes = {} - self.n_expected_failures = 0 - self.expected_failures = {} - self.n_missing_libs = 0 - self.missing_libs = {} - self.n_unexpected_passes = 0 - self.unexpected_passes = {} - self.n_unexpected_failures = 0 - self.unexpected_failures = {} - self.n_unexpected_stat_failures = 0 - self.unexpected_stat_failures = {} - - global t - t = TestRun() - - def getTestRun(): - return t - - # ----------------------------------------------------------------------------- - # Information about the current test - - class TestOptions: - def __init__(self): - # if not None then we look for namebase.stderr etc rather than - # using the test name - self.with_namebase = None - - # skip this test? - self.skip = 0 - - # skip these ways - self.omit_ways = [] - - # skip all ways except these (None == do all ways) - self.only_ways = None - - # add these ways to the default set - self.extra_ways = [] - - # the result we normally expect for this test - self.expect = 'pass' - - # override the expected result for certain ways - self.expect_fail_for = [] - - # the stdin file that this test will use (empty for .stdin) - self.stdin = '' - - # don't compare output - self.ignore_output = 0 - - # don't give anything as stdin - self.no_stdin = 0 - - # compile this test to .hc only - self.compile_to_hc = 0 - - # We sometimes want to modify the compiler_always_flags, so - # they are copied from config.compiler_always_flags when we - # make a new instance of TestOptions. - self.compiler_always_flags = [] - - # extra compiler opts for this test - self.extra_hc_opts = '' - - # extra run opts for this test - self.extra_run_opts = '' - - # expected exit code - self.exit_code = 0 - - # should we clean up after ourselves? - self.cleanup = '' - - # extra files to clean afterward - self.clean_files = [] - - # which -t numeric fields do we want to look at, and what bounds must - # they fall within? - # Elements of these lists should be things like - # ('bytes allocated', - # 9300000000, - # 10) - # To allow a 10% deviation from 9300000000. - self.compiler_stats_range_fields = {} - self.stats_range_fields = {} - - # should we run this test alone, i.e. not run it in parallel with - # any other threads - self.alone = False - - # Does this test use a literate (.lhs) file? - self.literate = 0 - - # Does this test use a .c, .m or .mm file? - self.c_src = 0 - self.objc_src = 0 - self.objcpp_src = 0 - - # Does this test use a .cmm file? - self.cmm_src = 0 - - # Should we put .hi/.o files in a subdirectory? - self.outputdir = None - - # Command to run before the test - self.pre_cmd = None - - # Command to run for extra cleaning - self.clean_cmd = None - - # Command wrapper: a function to apply to the command before running it - self.cmd_wrapper = None - - # Prefix to put on the command before compiling it - self.compile_cmd_prefix = '' - - # Extra output normalisation - self.extra_normaliser = lambda x: x - - # Custom output checker, otherwise do a comparison with expected - # stdout file. Accepts two arguments: filename of actual stdout - # output, and a normaliser function given other test options - self.check_stdout = None - - # Extra normalisation for compiler error messages - self.extra_errmsg_normaliser = lambda x: x - - # The directory the test is in - self.testdir = '.' - - # Should we redirect stdout and stderr to a single file? - self.combined_output = False - - # How should the timeout be adjusted on this test? - self.timeout_multiplier = 1.0 - - # The default set of options - global default_testopts - default_testopts = TestOptions() - - # (bug, directory, name) of tests marked broken - global brokens - brokens = [] - -EOF -chmod 644 'ghc-test-framework/driver/testglobals.py' - -mkdir -p 'ghc-test-framework/driver' -sed "s/^ //" <<"EOF" >'ghc-test-framework/driver/testlib.py' - # - # (c) Simon Marlow 2002 - # - - from __future__ import print_function - - import shutil - import sys - import os - import errno - import string - import re - import traceback - import time - import datetime - import copy - import glob - from math import ceil, trunc - import collections - - have_subprocess = False - try: - import subprocess - have_subprocess = True - except: - print("Warning: subprocess not found, will fall back to spawnv") - - from testglobals import * - from testutil import * - - if config.use_threads: - import threading - try: - import thread - except ImportError: # Python 3 - import _thread as thread - - global wantToStop - wantToStop = False - def stopNow(): - global wantToStop - wantToStop = True - def stopping(): - return wantToStop - - # Options valid for the current test only (these get reset to - # testdir_testopts after each test). - - global testopts_local - if config.use_threads: - testopts_local = threading.local() - else: - class TestOpts_Local: - pass - testopts_local = TestOpts_Local() - - def getTestOpts(): - return testopts_local.x - - def setLocalTestOpts(opts): - global testopts_local - testopts_local.x=opts - - def isStatsTest(): - opts = getTestOpts() - return len(opts.compiler_stats_range_fields) > 0 or len(opts.stats_range_fields) > 0 - - - # This can be called at the top of a file of tests, to set default test options - # for the following tests. - def setTestOpts( f ): - global thisdir_settings - thisdir_settings = [thisdir_settings, f] - - # ----------------------------------------------------------------------------- - # Canned setup functions for common cases. eg. for a test you might say - # - # test('test001', normal, compile, ['']) - # - # to run it without any options, but change it to - # - # test('test001', expect_fail, compile, ['']) - # - # to expect failure for this test. - - def normal( name, opts ): - return; - - def skip( name, opts ): - opts.skip = 1 - - def expect_fail( name, opts ): - opts.expect = 'fail'; - - def reqlib( lib ): - return lambda name, opts, l=lib: _reqlib (name, opts, l ) - - # Cache the results of looking to see if we have a library or not. - # This makes quite a difference, especially on Windows. - have_lib = {} - - def _reqlib( name, opts, lib ): - if lib in have_lib: - got_it = have_lib[lib] - else: - if have_subprocess: - # By preference we use subprocess, as the alternative uses - # /dev/null which mingw doesn't have. - cmd = strip_quotes(config.ghc_pkg) - p = subprocess.Popen([cmd, '--no-user-package-db', 'describe', lib], - stdout=subprocess.PIPE, - stderr=subprocess.PIPE) - # read from stdout and stderr to avoid blocking due to - # buffers filling - p.communicate() - r = p.wait() - else: - r = os.system(config.ghc_pkg + ' --no-user-package-db describe ' - + lib + ' > /dev/null 2> /dev/null') - got_it = r == 0 - have_lib[lib] = got_it - - if not got_it: - opts.expect = 'missing-lib' - - def req_profiling( name, opts ): - if not config.have_profiling: - opts.expect = 'fail' - - def req_shared_libs( name, opts ): - if not config.have_shared_libs: - opts.expect = 'fail' - - def req_interp( name, opts ): - if not config.have_interp: - opts.expect = 'fail' - - def req_smp( name, opts ): - if not config.have_smp: - opts.expect = 'fail' - - def ignore_output( name, opts ): - opts.ignore_output = 1 - - def no_stdin( name, opts ): - opts.no_stdin = 1 - - def combined_output( name, opts ): - opts.combined_output = True - - # ----- - - def expect_fail_for( ways ): - return lambda name, opts, w=ways: _expect_fail_for( name, opts, w ) - - def _expect_fail_for( name, opts, ways ): - opts.expect_fail_for = ways - - def expect_broken( bug ): - return lambda name, opts, b=bug: _expect_broken (name, opts, b ) - - def _expect_broken( name, opts, bug ): - record_broken(name, opts, bug) - opts.expect = 'fail'; - - def expect_broken_for( bug, ways ): - return lambda name, opts, b=bug, w=ways: _expect_broken_for( name, opts, b, w ) - - def _expect_broken_for( name, opts, bug, ways ): - record_broken(name, opts, bug) - opts.expect_fail_for = ways - - def record_broken(name, opts, bug): - global brokens - me = (bug, opts.testdir, name) - if not me in brokens: - brokens.append(me) - - # ----- - - def omit_ways( ways ): - return lambda name, opts, w=ways: _omit_ways( name, opts, w ) - - def _omit_ways( name, opts, ways ): - opts.omit_ways = ways - - # ----- - - def only_ways( ways ): - return lambda name, opts, w=ways: _only_ways( name, opts, w ) - - def _only_ways( name, opts, ways ): - opts.only_ways = ways - - # ----- - - def extra_ways( ways ): - return lambda name, opts, w=ways: _extra_ways( name, opts, w ) - - def _extra_ways( name, opts, ways ): - opts.extra_ways = ways - - # ----- - - def omit_compiler_types( compiler_types ): - return lambda name, opts, c=compiler_types: _omit_compiler_types(name, opts, c) - - def _omit_compiler_types( name, opts, compiler_types ): - if config.compiler_type in compiler_types: - opts.skip = 1 - - # ----- - - def only_compiler_types( compiler_types ): - return lambda name, opts, c=compiler_types: _only_compiler_types(name, opts, c) - - def _only_compiler_types( name, opts, compiler_types ): - if config.compiler_type not in compiler_types: - opts.skip = 1 - - # ----- - - def set_stdin( file ): - return lambda name, opts, f=file: _set_stdin(name, opts, f); - - def _set_stdin( name, opts, f ): - opts.stdin = f - - # ----- - - def exit_code( val ): - return lambda name, opts, v=val: _exit_code(name, opts, v); - - def _exit_code( name, opts, v ): - opts.exit_code = v - - def signal_exit_code( val ): - if opsys('solaris2'): - return exit_code( val ); - else: - # When application running on Linux receives fatal error - # signal, then its exit code is encoded as 128 + signal - # value. See http://www.tldp.org/LDP/abs/html/exitcodes.html - # I assume that Mac OS X behaves in the same way at least Mac - # OS X builder behavior suggests this. - return exit_code( val+128 ); - - # ----- - - def timeout_multiplier( val ): - return lambda name, opts, v=val: _timeout_multiplier(name, opts, v) - - def _timeout_multiplier( name, opts, v ): - opts.timeout_multiplier = v - - # ----- - - def extra_run_opts( val ): - return lambda name, opts, v=val: _extra_run_opts(name, opts, v); - - def _extra_run_opts( name, opts, v ): - opts.extra_run_opts = v - - # ----- - - def extra_hc_opts( val ): - return lambda name, opts, v=val: _extra_hc_opts(name, opts, v); - - def _extra_hc_opts( name, opts, v ): - opts.extra_hc_opts = v - - # ----- - - def extra_clean( files ): - return lambda name, opts, v=files: _extra_clean(name, opts, v); - - def _extra_clean( name, opts, v ): - opts.clean_files = v - - # ----- - - def stats_num_field( field, expecteds ): - return lambda name, opts, f=field, e=expecteds: _stats_num_field(name, opts, f, e); - - def _stats_num_field( name, opts, field, expecteds ): - if field in opts.stats_range_fields: - framework_fail(name, 'duplicate-numfield', 'Duplicate ' + field + ' num_field check') - - if type(expecteds) is list: - for (b, expected, dev) in expecteds: - if b: - opts.stats_range_fields[field] = (expected, dev) - return - framework_fail(name, 'numfield-no-expected', 'No expected value found for ' + field + ' in num_field check') - - else: - (expected, dev) = expecteds - opts.stats_range_fields[field] = (expected, dev) - - def compiler_stats_num_field( field, expecteds ): - return lambda name, opts, f=field, e=expecteds: _compiler_stats_num_field(name, opts, f, e); - - def _compiler_stats_num_field( name, opts, field, expecteds ): - if field in opts.compiler_stats_range_fields: - framework_fail(name, 'duplicate-numfield', 'Duplicate ' + field + ' num_field check') - - # Compiler performance numbers change when debugging is on, making the results - # useless and confusing. Therefore, skip if debugging is on. - if compiler_debugged(): - skip(name, opts) - - for (b, expected, dev) in expecteds: - if b: - opts.compiler_stats_range_fields[field] = (expected, dev) - return - - framework_fail(name, 'numfield-no-expected', 'No expected value found for ' + field + ' in num_field check') - - # ----- - - def when(b, f): - # When list_brokens is on, we want to see all expect_broken calls, - # so we always do f - if b or config.list_broken: - return f - else: - return normal - - def unless(b, f): - return when(not b, f) - - def doing_ghci(): - return 'ghci' in config.run_ways - - def ghci_dynamic( ): - return config.ghc_dynamic - - def fast(): - return config.fast - - def platform( plat ): - return config.platform == plat - - def opsys( os ): - return config.os == os - - def arch( arch ): - return config.arch == arch - - def wordsize( ws ): - return config.wordsize == str(ws) - - def msys( ): - return config.msys - - def cygwin( ): - return config.cygwin - - def have_vanilla( ): - return config.have_vanilla - - def have_dynamic( ): - return config.have_dynamic - - def have_profiling( ): - return config.have_profiling - - def in_tree_compiler( ): - return config.in_tree_compiler - - def compiler_type( compiler ): - return config.compiler_type == compiler - - def compiler_lt( compiler, version ): - return config.compiler_type == compiler and \ - version_lt(config.compiler_version, version) - - def compiler_le( compiler, version ): - return config.compiler_type == compiler and \ - version_le(config.compiler_version, version) - - def compiler_gt( compiler, version ): - return config.compiler_type == compiler and \ - version_gt(config.compiler_version, version) - - def compiler_ge( compiler, version ): - return config.compiler_type == compiler and \ - version_ge(config.compiler_version, version) - - def unregisterised( ): - return config.unregisterised - - def compiler_profiled( ): - return config.compiler_profiled - - def compiler_debugged( ): - return config.compiler_debugged - - def tag( t ): - return t in config.compiler_tags - - # --- - - def namebase( nb ): - return lambda opts, nb=nb: _namebase(opts, nb) - - def _namebase( opts, nb ): - opts.with_namebase = nb - - # --- - - def high_memory_usage(name, opts): - opts.alone = True - - # If a test is for a multi-CPU race, then running the test alone - # increases the chance that we'll actually see it. - def multi_cpu_race(name, opts): - opts.alone = True - - # --- - def literate( name, opts ): - opts.literate = 1; - - def c_src( name, opts ): - opts.c_src = 1; - - def objc_src( name, opts ): - opts.objc_src = 1; - - def objcpp_src( name, opts ): - opts.objcpp_src = 1; - - def cmm_src( name, opts ): - opts.cmm_src = 1; - - def outputdir( odir ): - return lambda name, opts, d=odir: _outputdir(name, opts, d) - - def _outputdir( name, opts, odir ): - opts.outputdir = odir; - - # ---- - - def pre_cmd( cmd ): - return lambda name, opts, c=cmd: _pre_cmd(name, opts, cmd) - - def _pre_cmd( name, opts, cmd ): - opts.pre_cmd = cmd - - # ---- - - def clean_cmd( cmd ): - return lambda name, opts, c=cmd: _clean_cmd(name, opts, cmd) - - def _clean_cmd( name, opts, cmd ): - opts.clean_cmd = cmd - - # ---- - - def cmd_prefix( prefix ): - return lambda name, opts, p=prefix: _cmd_prefix(name, opts, prefix) - - def _cmd_prefix( name, opts, prefix ): - opts.cmd_wrapper = lambda cmd, p=prefix: p + ' ' + cmd; - - # ---- - - def cmd_wrapper( fun ): - return lambda name, opts, f=fun: _cmd_wrapper(name, opts, fun) - - def _cmd_wrapper( name, opts, fun ): - opts.cmd_wrapper = fun - - # ---- - - def compile_cmd_prefix( prefix ): - return lambda name, opts, p=prefix: _compile_cmd_prefix(name, opts, prefix) - - def _compile_cmd_prefix( name, opts, prefix ): - opts.compile_cmd_prefix = prefix - - # ---- - - def check_stdout( f ): - return lambda name, opts, f=f: _check_stdout(name, opts, f) - - def _check_stdout( name, opts, f ): - opts.check_stdout = f - - # ---- - - def normalise_slashes( name, opts ): - _normalise_fun(name, opts, normalise_slashes_) - - def normalise_exe( name, opts ): - _normalise_fun(name, opts, normalise_exe_) - - def normalise_fun( *fs ): - return lambda name, opts: _normalise_fun(name, opts, fs) - - def _normalise_fun( name, opts, *fs ): - opts.extra_normaliser = join_normalisers(opts.extra_normaliser, fs) - - def normalise_errmsg_fun( *fs ): - return lambda name, opts: _normalise_errmsg_fun(name, opts, fs) - - def _normalise_errmsg_fun( name, opts, *fs ): - opts.extra_errmsg_normaliser = join_normalisers(opts.extra_errmsg_normaliser, fs) - - def normalise_version_( *pkgs ): - def normalise_version__( str ): - return re.sub('(' + '|'.join(map(re.escape,pkgs)) + ')-[0-9.]+', - '\\1-', str) - return normalise_version__ - - def normalise_version( *pkgs ): - def normalise_version__( name, opts ): - _normalise_fun(name, opts, normalise_version_(*pkgs)) - _normalise_errmsg_fun(name, opts, normalise_version_(*pkgs)) - return normalise_version__ - - def join_normalisers(*a): - """ - Compose functions, flattening sequences. - - join_normalisers(f1,[f2,f3],f4) - - is the same as - - lambda x: f1(f2(f3(f4(x)))) - """ - - def flatten(l): - """ - Taken from http://stackoverflow.com/a/2158532/946226 - """ - for el in l: - if isinstance(el, collections.Iterable) and not isinstance(el, basestring): - for sub in flatten(el): - yield sub - else: - yield el - - a = flatten(a) - - fn = lambda x:x # identity function - for f in a: - assert callable(f) - fn = lambda x,f=f,fn=fn: fn(f(x)) - return fn - - # ---- - # Function for composing two opt-fns together - - def executeSetups(fs, name, opts): - if type(fs) is list: - # If we have a list of setups, then execute each one - for f in fs: - executeSetups(f, name, opts) - else: - # fs is a single function, so just apply it - fs(name, opts) - - # ----------------------------------------------------------------------------- - # The current directory of tests - - def newTestDir( dir ): - global thisdir_settings - # reset the options for this test directory - thisdir_settings = lambda name, opts, dir=dir: _newTestDir( name, opts, dir ) - - def _newTestDir( name, opts, dir ): - opts.testdir = dir - opts.compiler_always_flags = config.compiler_always_flags - - # ----------------------------------------------------------------------------- - # Actually doing tests - - parallelTests = [] - aloneTests = [] - allTestNames = set([]) - - def runTest (opts, name, func, args): - ok = 0 - - if config.use_threads: - t.thread_pool.acquire() - try: - while config.threads<(t.running_threads+1): - t.thread_pool.wait() - t.running_threads = t.running_threads+1 - ok=1 - t.thread_pool.release() - thread.start_new_thread(test_common_thread, (name, opts, func, args)) - except: - if not ok: - t.thread_pool.release() - else: - test_common_work (name, opts, func, args) - - # name :: String - # setup :: TestOpts -> IO () - def test (name, setup, func, args): - global aloneTests - global parallelTests - global allTestNames - global thisdir_settings - if name in allTestNames: - framework_fail(name, 'duplicate', 'There are multiple tests with this name') - if not re.match('^[0-9]*[a-zA-Z][a-zA-Z0-9._-]*$', name): - framework_fail(name, 'bad_name', 'This test has an invalid name') - - # Make a deep copy of the default_testopts, as we need our own copy - # of any dictionaries etc inside it. Otherwise, if one test modifies - # them, all tests will see the modified version! - myTestOpts = copy.deepcopy(default_testopts) - - executeSetups([thisdir_settings, setup], name, myTestOpts) - - thisTest = lambda : runTest(myTestOpts, name, func, args) - if myTestOpts.alone: - aloneTests.append(thisTest) - else: - parallelTests.append(thisTest) - allTestNames.add(name) - - if config.use_threads: - def test_common_thread(name, opts, func, args): - t.lock.acquire() - try: - test_common_work(name,opts,func,args) - finally: - t.lock.release() - t.thread_pool.acquire() - t.running_threads = t.running_threads - 1 - t.thread_pool.notify() - t.thread_pool.release() - - def get_package_cache_timestamp(): - if config.package_conf_cache_file == '': - return 0.0 - else: - try: - return os.stat(config.package_conf_cache_file).st_mtime - except: - return 0.0 - - - def test_common_work (name, opts, func, args): - try: - t.total_tests = t.total_tests+1 - setLocalTestOpts(opts) - - package_conf_cache_file_start_timestamp = get_package_cache_timestamp() - - # All the ways we might run this test - if func == compile or func == multimod_compile: - all_ways = config.compile_ways - elif func == compile_and_run or func == multimod_compile_and_run: - all_ways = config.run_ways - elif func == ghci_script: - if 'ghci' in config.run_ways: - all_ways = ['ghci'] - else: - all_ways = [] - else: - all_ways = ['normal'] - - # A test itself can request extra ways by setting opts.extra_ways - all_ways = all_ways + [way for way in opts.extra_ways if way not in all_ways] - - t.total_test_cases = t.total_test_cases + len(all_ways) - - ok_way = lambda way: \ - not getTestOpts().skip \ - and (config.only == [] or name in config.only) \ - and (getTestOpts().only_ways == None or way in getTestOpts().only_ways) \ - and (config.cmdline_ways == [] or way in config.cmdline_ways) \ - and (not (config.skip_perf_tests and isStatsTest())) \ - and way not in getTestOpts().omit_ways - - # Which ways we are asked to skip - do_ways = list(filter (ok_way,all_ways)) - - # In fast mode, we skip all but one way - if config.fast and len(do_ways) > 0: - do_ways = [do_ways[0]] - - if not config.clean_only: - # Run the required tests... - for way in do_ways: - if stopping(): - break - do_test (name, way, func, args) - - for way in all_ways: - if way not in do_ways: - skiptest (name,way) - - if getTestOpts().cleanup != '' and (config.clean_only or do_ways != []): - pretest_cleanup(name) - clean([name + suff for suff in [ - '', '.exe', '.exe.manifest', '.genscript', - '.stderr.normalised', '.stdout.normalised', - '.run.stderr.normalised', '.run.stdout.normalised', - '.comp.stderr.normalised', '.comp.stdout.normalised', - '.interp.stderr.normalised', '.interp.stdout.normalised', - '.stats', '.comp.stats', - '.hi', '.o', '.prof', '.exe.prof', '.hc', - '_stub.h', '_stub.c', '_stub.o', - '.hp', '.exe.hp', '.ps', '.aux', '.hcr', '.eventlog']]) - - if func == multi_compile or func == multi_compile_fail: - extra_mods = args[1] - clean([replace_suffix(fx[0],'o') for fx in extra_mods]) - clean([replace_suffix(fx[0], 'hi') for fx in extra_mods]) - - - clean(getTestOpts().clean_files) - - if getTestOpts().outputdir != None: - odir = in_testdir(getTestOpts().outputdir) - try: - shutil.rmtree(odir) - except: - pass - - try: - shutil.rmtree(in_testdir('.hpc.' + name)) - except: - pass - - try: - cleanCmd = getTestOpts().clean_cmd - if cleanCmd != None: - result = runCmdFor(name, 'cd ' + getTestOpts().testdir + ' && ' + cleanCmd) - if result != 0: - framework_fail(name, 'cleaning', 'clean-command failed: ' + str(result)) - except: - framework_fail(name, 'cleaning', 'clean-command exception') - - package_conf_cache_file_end_timestamp = get_package_cache_timestamp(); - - if package_conf_cache_file_start_timestamp != package_conf_cache_file_end_timestamp: - framework_fail(name, 'whole-test', 'Package cache timestamps do not match: ' + str(package_conf_cache_file_start_timestamp) + ' ' + str(package_conf_cache_file_end_timestamp)) - - try: - for f in files_written[name]: - if os.path.exists(f): - try: - if not f in files_written_not_removed[name]: - files_written_not_removed[name].append(f) - except: - files_written_not_removed[name] = [f] - except: - pass - except Exception as e: - framework_fail(name, 'runTest', 'Unhandled exception: ' + str(e)) - - def clean(strs): - for str in strs: - for name in glob.glob(in_testdir(str)): - clean_full_path(name) - - def clean_full_path(name): - try: - # Remove files... - os.remove(name) - except OSError as e1: - try: - # ... and empty directories - os.rmdir(name) - except OSError as e2: - # We don't want to fail here, but we do want to know - # what went wrong, so print out the exceptions. - # ENOENT isn't a problem, though, as we clean files - # that don't necessarily exist. - if e1.errno != errno.ENOENT: - print(e1) - if e2.errno != errno.ENOENT: - print(e2) - - def do_test(name, way, func, args): - full_name = name + '(' + way + ')' - - try: - if_verbose(2, "=====> %s %d of %d %s " % \ - (full_name, t.total_tests, len(allTestNames), \ - [t.n_unexpected_passes, \ - t.n_unexpected_failures, \ - t.n_framework_failures])) - - if config.use_threads: - t.lock.release() - - try: - preCmd = getTestOpts().pre_cmd - if preCmd != None: - result = runCmdFor(name, 'cd ' + getTestOpts().testdir + ' && ' + preCmd) - if result != 0: - framework_fail(name, way, 'pre-command failed: ' + str(result)) - except: - framework_fail(name, way, 'pre-command exception') - - try: - result = func(*[name,way] + args) - finally: - if config.use_threads: - t.lock.acquire() - - if getTestOpts().expect != 'pass' and \ - getTestOpts().expect != 'fail' and \ - getTestOpts().expect != 'missing-lib': - framework_fail(name, way, 'bad expected ' + getTestOpts().expect) - - try: - passFail = result['passFail'] - except: - passFail = 'No passFail found' - - if passFail == 'pass': - if getTestOpts().expect == 'pass' \ - and way not in getTestOpts().expect_fail_for: - t.n_expected_passes = t.n_expected_passes + 1 - if name in t.expected_passes: - t.expected_passes[name].append(way) - else: - t.expected_passes[name] = [way] - else: - if_verbose(1, '*** unexpected pass for %s' % full_name) - t.n_unexpected_passes = t.n_unexpected_passes + 1 - addPassingTestInfo(t.unexpected_passes, getTestOpts().testdir, name, way) - elif passFail == 'fail': - if getTestOpts().expect == 'pass' \ - and way not in getTestOpts().expect_fail_for: - reason = result['reason'] - tag = result.get('tag') - if tag == 'stat': - if_verbose(1, '*** unexpected stat test failure for %s' % full_name) - t.n_unexpected_stat_failures = t.n_unexpected_stat_failures + 1 - addFailingTestInfo(t.unexpected_stat_failures, getTestOpts().testdir, name, reason, way) - else: - if_verbose(1, '*** unexpected failure for %s' % full_name) - t.n_unexpected_failures = t.n_unexpected_failures + 1 - addFailingTestInfo(t.unexpected_failures, getTestOpts().testdir, name, reason, way) - else: - if getTestOpts().expect == 'missing-lib': - t.n_missing_libs = t.n_missing_libs + 1 - if name in t.missing_libs: - t.missing_libs[name].append(way) - else: - t.missing_libs[name] = [way] - else: - t.n_expected_failures = t.n_expected_failures + 1 - if name in t.expected_failures: - t.expected_failures[name].append(way) - else: - t.expected_failures[name] = [way] - else: - framework_fail(name, way, 'bad result ' + passFail) - except KeyboardInterrupt: - stopNow() - except: - framework_fail(name, way, 'do_test exception') - traceback.print_exc() - - def addPassingTestInfo (testInfos, directory, name, way): - directory = re.sub('^\\.[/\\\\]', '', directory) - - if not directory in testInfos: - testInfos[directory] = {} - - if not name in testInfos[directory]: - testInfos[directory][name] = [] - - testInfos[directory][name].append(way) - - def addFailingTestInfo (testInfos, directory, name, reason, way): - directory = re.sub('^\\.[/\\\\]', '', directory) - - if not directory in testInfos: - testInfos[directory] = {} - - if not name in testInfos[directory]: - testInfos[directory][name] = {} - - if not reason in testInfos[directory][name]: - testInfos[directory][name][reason] = [] - - testInfos[directory][name][reason].append(way) - - def skiptest (name, way): - # print 'Skipping test \"', name, '\"' - t.n_tests_skipped = t.n_tests_skipped + 1 - if name in t.tests_skipped: - t.tests_skipped[name].append(way) - else: - t.tests_skipped[name] = [way] - - def framework_fail( name, way, reason ): - full_name = name + '(' + way + ')' - if_verbose(1, '*** framework failure for %s %s ' % (full_name, reason)) - t.n_framework_failures = t.n_framework_failures + 1 - if name in t.framework_failures: - t.framework_failures[name].append(way) - else: - t.framework_failures[name] = [way] - - def badResult(result): - try: - if result['passFail'] == 'pass': - return False - return True - except: - return True - - def passed(): - return {'passFail': 'pass'} - - def failBecause(reason, tag=None): - return {'passFail': 'fail', 'reason': reason, 'tag': tag} - - # ----------------------------------------------------------------------------- - # Generic command tests - - # A generic command test is expected to run and exit successfully. - # - # The expected exit code can be changed via exit_code() as normal, and - # the expected stdout/stderr are stored in .stdout and - # .stderr. The output of the command can be ignored - # altogether by using run_command_ignore_output instead of - # run_command. - - def run_command( name, way, cmd ): - return simple_run( name, '', cmd, '' ) - - # ----------------------------------------------------------------------------- - # GHCi tests - - def ghci_script_without_flag(flag): - def apply(name, way, script): - overrides = [f for f in getTestOpts().compiler_always_flags if f != flag] - return ghci_script_override_default_flags(overrides)(name, way, script) - - return apply - - def ghci_script_override_default_flags(overrides): - def apply(name, way, script): - return ghci_script(name, way, script, overrides) - - return apply - - def ghci_script( name, way, script, override_flags = None ): - # filter out -fforce-recomp from compiler_always_flags, because we're - # actually testing the recompilation behaviour in the GHCi tests. - flags = ' '.join(get_compiler_flags(override_flags, noforce=True)) - - way_flags = ' '.join(config.way_flags(name)['ghci']) - - # We pass HC and HC_OPTS as environment variables, so that the - # script can invoke the correct compiler by using ':! $HC $HC_OPTS' - cmd = ('HC={{compiler}} HC_OPTS="{flags}" {{compiler}} {flags} {way_flags}' - ).format(flags=flags, way_flags=way_flags) - - getTestOpts().stdin = script - return simple_run( name, way, cmd, getTestOpts().extra_run_opts ) - - # ----------------------------------------------------------------------------- - # Compile-only tests - - def compile_override_default_flags(overrides): - def apply(name, way, extra_opts): - return do_compile(name, way, 0, '', [], extra_opts, overrides) - - return apply - - def compile_fail_override_default_flags(overrides): - def apply(name, way, extra_opts): - return do_compile(name, way, 1, '', [], extra_opts, overrides) - - return apply - - def compile_without_flag(flag): - def apply(name, way, extra_opts): - overrides = [f for f in getTestOpts().compiler_always_flags if f != flag] - return compile_override_default_flags(overrides)(name, way, extra_opts) - - return apply - - def compile_fail_without_flag(flag): - def apply(name, way, extra_opts): - overrides = [f for f in getTestOpts.compiler_always_flags if f != flag] - return compile_fail_override_default_flags(overrides)(name, way, extra_opts) - - return apply - - def compile( name, way, extra_hc_opts ): - return do_compile( name, way, 0, '', [], extra_hc_opts ) - - def compile_fail( name, way, extra_hc_opts ): - return do_compile( name, way, 1, '', [], extra_hc_opts ) - - def multimod_compile( name, way, top_mod, extra_hc_opts ): - return do_compile( name, way, 0, top_mod, [], extra_hc_opts ) - - def multimod_compile_fail( name, way, top_mod, extra_hc_opts ): - return do_compile( name, way, 1, top_mod, [], extra_hc_opts ) - - def multi_compile( name, way, top_mod, extra_mods, extra_hc_opts ): - return do_compile( name, way, 0, top_mod, extra_mods, extra_hc_opts) - - def multi_compile_fail( name, way, top_mod, extra_mods, extra_hc_opts ): - return do_compile( name, way, 1, top_mod, extra_mods, extra_hc_opts) - - def do_compile( name, way, should_fail, top_mod, extra_mods, extra_hc_opts, override_flags = None ): - # print 'Compile only, extra args = ', extra_hc_opts - pretest_cleanup(name) - - result = extras_build( way, extra_mods, extra_hc_opts ) - if badResult(result): - return result - extra_hc_opts = result['hc_opts'] - - force = 0 - if extra_mods: - force = 1 - result = simple_build( name, way, extra_hc_opts, should_fail, top_mod, 0, 1, force, override_flags ) - - if badResult(result): - return result - - # the actual stderr should always match the expected, regardless - # of whether we expected the compilation to fail or not (successful - # compilations may generate warnings). - - if getTestOpts().with_namebase == None: - namebase = name - else: - namebase = getTestOpts().with_namebase - - (platform_specific, expected_stderr_file) = platform_wordsize_qualify(namebase, 'stderr') - actual_stderr_file = qualify(name, 'comp.stderr') - - if not compare_outputs(way, 'stderr', - join_normalisers(getTestOpts().extra_errmsg_normaliser, - normalise_errmsg, - normalise_whitespace), - expected_stderr_file, actual_stderr_file): - return failBecause('stderr mismatch') - - # no problems found, this test passed - return passed() - - def compile_cmp_asm( name, way, extra_hc_opts ): - print('Compile only, extra args = ', extra_hc_opts) - pretest_cleanup(name) - result = simple_build( name + '.cmm', way, '-keep-s-files -O ' + extra_hc_opts, 0, '', 0, 0, 0) - - if badResult(result): - return result - - # the actual stderr should always match the expected, regardless - # of whether we expected the compilation to fail or not (successful - # compilations may generate warnings). - - if getTestOpts().with_namebase == None: - namebase = name - else: - namebase = getTestOpts().with_namebase - - (platform_specific, expected_asm_file) = platform_wordsize_qualify(namebase, 'asm') - actual_asm_file = qualify(name, 's') - - if not compare_outputs(way, 'asm', - join_normalisers(normalise_errmsg, normalise_asm), - expected_asm_file, actual_asm_file): - return failBecause('asm mismatch') - - # no problems found, this test passed - return passed() - - # ----------------------------------------------------------------------------- - # Compile-and-run tests - - def compile_and_run__( name, way, top_mod, extra_mods, extra_hc_opts ): - # print 'Compile and run, extra args = ', extra_hc_opts - pretest_cleanup(name) - - result = extras_build( way, extra_mods, extra_hc_opts ) - if badResult(result): - return result - extra_hc_opts = result['hc_opts'] - - if way == 'ghci': # interpreted... - return interpreter_run( name, way, extra_hc_opts, 0, top_mod ) - else: # compiled... - force = 0 - if extra_mods: - force = 1 - - result = simple_build( name, way, extra_hc_opts, 0, top_mod, 1, 1, force) - if badResult(result): - return result - - cmd = './' + name; - - # we don't check the compiler's stderr for a compile-and-run test - return simple_run( name, way, cmd, getTestOpts().extra_run_opts ) - - def compile_and_run( name, way, extra_hc_opts ): - return compile_and_run__( name, way, '', [], extra_hc_opts) - - def multimod_compile_and_run( name, way, top_mod, extra_hc_opts ): - return compile_and_run__( name, way, top_mod, [], extra_hc_opts) - - def multi_compile_and_run( name, way, top_mod, extra_mods, extra_hc_opts ): - return compile_and_run__( name, way, top_mod, extra_mods, extra_hc_opts) - - def stats( name, way, stats_file ): - opts = getTestOpts() - return checkStats(name, way, stats_file, opts.stats_range_fields) - - # ----------------------------------------------------------------------------- - # Check -t stats info - - def checkStats(name, way, stats_file, range_fields): - full_name = name + '(' + way + ')' - - result = passed() - if len(range_fields) > 0: - f = open(in_testdir(stats_file)) - contents = f.read() - f.close() - - for (field, (expected, dev)) in range_fields.items(): - m = re.search('\("' + field + '", "([0-9]+)"\)', contents) - if m == None: - print('Failed to find field: ', field) - result = failBecause('no such stats field') - val = int(m.group(1)) - - lowerBound = trunc( expected * ((100 - float(dev))/100)) - upperBound = trunc(0.5 + ceil(expected * ((100 + float(dev))/100))) - - deviation = round(((float(val) * 100)/ expected) - 100, 1) - - if val < lowerBound: - print(field, 'value is too low:') - print('(If this is because you have improved GHC, please') - print('update the test so that GHC doesn\'t regress again)') - result = failBecause('stat too good', tag='stat') - if val > upperBound: - print(field, 'value is too high:') - result = failBecause('stat not good enough', tag='stat') - - if val < lowerBound or val > upperBound or config.verbose >= 4: - valStr = str(val) - valLen = len(valStr) - expectedStr = str(expected) - expectedLen = len(expectedStr) - length = max(len(str(x)) for x in [expected, lowerBound, upperBound, val]) - - def display(descr, val, extra): - print(descr, str(val).rjust(length), extra) - - display(' Expected ' + full_name + ' ' + field + ':', expected, '+/-' + str(dev) + '%') - display(' Lower bound ' + full_name + ' ' + field + ':', lowerBound, '') - display(' Upper bound ' + full_name + ' ' + field + ':', upperBound, '') - display(' Actual ' + full_name + ' ' + field + ':', val, '') - if val != expected: - display(' Deviation ' + full_name + ' ' + field + ':', deviation, '%') - - return result - - # ----------------------------------------------------------------------------- - # Build a single-module program - - def extras_build( way, extra_mods, extra_hc_opts ): - for modopts in extra_mods: - mod, opts = modopts - result = simple_build( mod, way, opts + ' ' + extra_hc_opts, 0, '', 0, 0, 0) - if not (mod.endswith('.hs') or mod.endswith('.lhs')): - extra_hc_opts += ' ' + replace_suffix(mod, 'o') - if badResult(result): - return result - - return {'passFail' : 'pass', 'hc_opts' : extra_hc_opts} - - - def simple_build( name, way, extra_hc_opts, should_fail, top_mod, link, addsuf, noforce, override_flags = None ): - opts = getTestOpts() - errname = add_suffix(name, 'comp.stderr') - rm_no_fail( qualify(errname, '') ) - - if top_mod != '': - srcname = top_mod - rm_no_fail( qualify(name, '') ) - base, suf = os.path.splitext(top_mod) - rm_no_fail( qualify(base, '') ) - rm_no_fail( qualify(base, 'exe') ) - elif addsuf: - srcname = add_hs_lhs_suffix(name) - rm_no_fail( qualify(name, '') ) - else: - srcname = name - rm_no_fail( qualify(name, 'o') ) - - rm_no_fail( qualify(replace_suffix(srcname, "o"), '') ) - - to_do = '' - if top_mod != '': - to_do = '--make ' - if link: - to_do = to_do + '-o ' + name - elif link: - to_do = '-o ' + name - elif opts.compile_to_hc: - to_do = '-C' - else: - to_do = '-c' # just compile - - stats_file = name + '.comp.stats' - if len(opts.compiler_stats_range_fields) > 0: - extra_hc_opts += ' +RTS -V0 -t' + stats_file + ' --machine-readable -RTS' - - # Required by GHC 7.3+, harmless for earlier versions: - if (getTestOpts().c_src or - getTestOpts().objc_src or - getTestOpts().objcpp_src or - getTestOpts().cmm_src): - extra_hc_opts += ' -no-hs-main ' - - if getTestOpts().compile_cmd_prefix == '': - cmd_prefix = '' - else: - cmd_prefix = getTestOpts().compile_cmd_prefix + ' ' - - flags = ' '.join(get_compiler_flags(override_flags, noforce) + - config.way_flags(name)[way]) - - cmd = ('cd {opts.testdir} && {cmd_prefix} ' - '{{compiler}} {to_do} {srcname} {flags} {extra_hc_opts} ' - '> {errname} 2>&1' - ).format(**locals()) - - result = runCmdFor(name, cmd) - - if result != 0 and not should_fail: - actual_stderr = qualify(name, 'comp.stderr') - if_verbose(1,'Compile failed (status ' + repr(result) + ') errors were:') - if_verbose_dump(1,actual_stderr) - - # ToDo: if the sub-shell was killed by ^C, then exit - - statsResult = checkStats(name, way, stats_file, opts.compiler_stats_range_fields) - - if badResult(statsResult): - return statsResult - - if should_fail: - if result == 0: - return failBecause('exit code 0') - else: - if result != 0: - return failBecause('exit code non-0') - - return passed() - - # ----------------------------------------------------------------------------- - # Run a program and check its output - # - # If testname.stdin exists, route input from that, else - # from /dev/null. Route output to testname.run.stdout and - # testname.run.stderr. Returns the exit code of the run. - - def simple_run( name, way, prog, args ): - opts = getTestOpts() - - # figure out what to use for stdin - if opts.stdin != '': - use_stdin = opts.stdin - else: - stdin_file = add_suffix(name, 'stdin') - if os.path.exists(in_testdir(stdin_file)): - use_stdin = stdin_file - else: - use_stdin = '/dev/null' - - run_stdout = add_suffix(name,'run.stdout') - run_stderr = add_suffix(name,'run.stderr') - - rm_no_fail(qualify(name,'run.stdout')) - rm_no_fail(qualify(name,'run.stderr')) - rm_no_fail(qualify(name, 'hp')) - rm_no_fail(qualify(name,'ps')) - rm_no_fail(qualify(name, 'prof')) - - my_rts_flags = rts_flags(way) - - stats_file = name + '.stats' - if len(opts.stats_range_fields) > 0: - args += ' +RTS -V0 -t' + stats_file + ' --machine-readable -RTS' - - if opts.no_stdin: - stdin_comes_from = '' - else: - stdin_comes_from = ' <' + use_stdin - - if opts.combined_output: - redirection = ' > {0} 2>&1'.format(run_stdout) - redirection_append = ' >> {0} 2>&1'.format(run_stdout) - else: - redirection = ' > {0} 2> {1}'.format(run_stdout, run_stderr) - redirection_append = ' >> {0} 2>> {1}'.format(run_stdout, run_stderr) - - cmd = prog + ' ' + args + ' ' \ - + my_rts_flags + ' ' \ - + stdin_comes_from \ - + redirection - - if opts.cmd_wrapper != None: - cmd = opts.cmd_wrapper(cmd) + redirection_append - - cmd = 'cd ' + opts.testdir + ' && ' + cmd - - # run the command - result = runCmdFor(name, cmd, timeout_multiplier=opts.timeout_multiplier) - - exit_code = result >> 8 - signal = result & 0xff - - # check the exit code - if exit_code != opts.exit_code: - print('Wrong exit code (expected', opts.exit_code, ', actual', exit_code, ')') - dump_stdout(name) - dump_stderr(name) - return failBecause('bad exit code') - - check_hp = my_rts_flags.find("-h") != -1 - check_prof = my_rts_flags.find("-p") != -1 - - if not opts.ignore_output: - bad_stderr = not opts.combined_output and not check_stderr_ok(name, way) - bad_stdout = not check_stdout_ok(name, way) - if bad_stderr: - return failBecause('bad stderr') - if bad_stdout: - return failBecause('bad stdout') - # exit_code > 127 probably indicates a crash, so don't try to run hp2ps. - if check_hp and (exit_code <= 127 or exit_code == 251) and not check_hp_ok(name): - return failBecause('bad heap profile') - if check_prof and not check_prof_ok(name, way): - return failBecause('bad profile') - - return checkStats(name, way, stats_file, opts.stats_range_fields) - - def rts_flags(way): - if (way == ''): - return '' - else: - args = config.way_rts_flags[way] - - if args == []: - return '' - else: - return '+RTS ' + ' '.join(args) + ' -RTS' - - # ----------------------------------------------------------------------------- - # Run a program in the interpreter and check its output - - def interpreter_run( name, way, extra_hc_opts, compile_only, top_mod ): - outname = add_suffix(name, 'interp.stdout') - errname = add_suffix(name, 'interp.stderr') - rm_no_fail(outname) - rm_no_fail(errname) - rm_no_fail(name) - - if (top_mod == ''): - srcname = add_hs_lhs_suffix(name) - else: - srcname = top_mod - - scriptname = add_suffix(name, 'genscript') - qscriptname = in_testdir(scriptname) - rm_no_fail(qscriptname) - - delimiter = '===== program output begins here\n' - - script = open(qscriptname, 'w') - if not compile_only: - # set the prog name and command-line args to match the compiled - # environment. - script.write(':set prog ' + name + '\n') - script.write(':set args ' + getTestOpts().extra_run_opts + '\n') - # Add marker lines to the stdout and stderr output files, so we - # can separate GHCi's output from the program's. - script.write(':! echo ' + delimiter) - script.write(':! echo 1>&2 ' + delimiter) - # Set stdout to be line-buffered to match the compiled environment. - script.write('System.IO.hSetBuffering System.IO.stdout System.IO.LineBuffering\n') - # wrapping in GHC.TopHandler.runIO ensures we get the same output - # in the event of an exception as for the compiled program. - script.write('GHC.TopHandler.runIOFastExit Main.main Prelude.>> Prelude.return ()\n') - script.close() - - # figure out what to use for stdin - if getTestOpts().stdin != '': - stdin_file = in_testdir(getTestOpts().stdin) - else: - stdin_file = qualify(name, 'stdin') - - if os.path.exists(stdin_file): - stdin = open(stdin_file, 'r') - os.system('cat ' + stdin_file + ' >>' + qscriptname) - - script.close() - - flags = ' '.join(get_compiler_flags(override_flags=None, noforce=False) + - config.way_flags(name)[way]) - - if getTestOpts().combined_output: - redirection = ' > {0} 2>&1'.format(outname) - redirection_append = ' >> {0} 2>&1'.format(outname) - else: - redirection = ' > {0} 2> {1}'.format(outname, errname) - redirection_append = ' >> {0} 2>> {1}'.format(outname, errname) - - cmd = ('{{compiler}} {srcname} {flags} {extra_hc_opts} ' - '< {scriptname} {redirection}' - ).format(**locals()) - - if getTestOpts().cmd_wrapper != None: - cmd = getTestOpts().cmd_wrapper(cmd) + redirection_append; - - cmd = 'cd ' + getTestOpts().testdir + " && " + cmd - - result = runCmdFor(name, cmd, timeout_multiplier=getTestOpts().timeout_multiplier) - - exit_code = result >> 8 - signal = result & 0xff - - # split the stdout into compilation/program output - split_file(in_testdir(outname), delimiter, - qualify(name, 'comp.stdout'), - qualify(name, 'run.stdout')) - split_file(in_testdir(errname), delimiter, - qualify(name, 'comp.stderr'), - qualify(name, 'run.stderr')) - - # check the exit code - if exit_code != getTestOpts().exit_code: - print('Wrong exit code (expected', getTestOpts().exit_code, ', actual', exit_code, ')') - dump_stdout(name) - dump_stderr(name) - return failBecause('bad exit code') - - # ToDo: if the sub-shell was killed by ^C, then exit - - if getTestOpts().ignore_output or (check_stderr_ok(name, way) and - check_stdout_ok(name, way)): - return passed() - else: - return failBecause('bad stdout or stderr') - - - def split_file(in_fn, delimiter, out1_fn, out2_fn): - infile = open(in_fn) - out1 = open(out1_fn, 'w') - out2 = open(out2_fn, 'w') - - line = infile.readline() - line = re.sub('\r', '', line) # ignore Windows EOL - while (re.sub('^\s*','',line) != delimiter and line != ''): - out1.write(line) - line = infile.readline() - line = re.sub('\r', '', line) - out1.close() - - line = infile.readline() - while (line != ''): - out2.write(line) - line = infile.readline() - out2.close() - - # ----------------------------------------------------------------------------- - # Utils - def get_compiler_flags(override_flags, noforce): - opts = getTestOpts() - - if override_flags is not None: - flags = copy.copy(override_flags) - else: - flags = copy.copy(opts.compiler_always_flags) - - if noforce: - flags = [f for f in flags if f != '-fforce-recomp'] - - flags.append(opts.extra_hc_opts) - - if opts.outputdir != None: - flags.extend(["-outputdir", opts.outputdir]) - - return flags - - def check_stdout_ok(name, way): - if getTestOpts().with_namebase == None: - namebase = name - else: - namebase = getTestOpts().with_namebase - - actual_stdout_file = qualify(name, 'run.stdout') - (platform_specific, expected_stdout_file) = platform_wordsize_qualify(namebase, 'stdout') - - def norm(str): - if platform_specific: - return str - else: - return normalise_output(str) - - extra_norm = join_normalisers(norm, getTestOpts().extra_normaliser) - - check_stdout = getTestOpts().check_stdout - if check_stdout: - return check_stdout(actual_stdout_file, extra_norm) - - return compare_outputs(way, 'stdout', extra_norm, - expected_stdout_file, actual_stdout_file) - - def dump_stdout( name ): - print('Stdout:') - print(read_no_crs(qualify(name, 'run.stdout'))) - - def check_stderr_ok(name, way): - if getTestOpts().with_namebase == None: - namebase = name - else: - namebase = getTestOpts().with_namebase - - actual_stderr_file = qualify(name, 'run.stderr') - (platform_specific, expected_stderr_file) = platform_wordsize_qualify(namebase, 'stderr') - - def norm(str): - if platform_specific: - return str - else: - return normalise_errmsg(str) - - return compare_outputs(way, 'stderr', - join_normalisers(norm, getTestOpts().extra_errmsg_normaliser), \ - expected_stderr_file, actual_stderr_file) - - def dump_stderr( name ): - print("Stderr:") - print(read_no_crs(qualify(name, 'run.stderr'))) - - def read_no_crs(file): - str = '' - try: - h = open(file) - str = h.read() - h.close - except: - # On Windows, if the program fails very early, it seems the - # files stdout/stderr are redirected to may not get created - pass - return re.sub('\r', '', str) - - def write_file(file, str): - h = open(file, 'w') - h.write(str) - h.close - - def check_hp_ok(name): - - # do not qualify for hp2ps because we should be in the right directory - hp2psCmd = "cd " + getTestOpts().testdir + " && {hp2ps} " + name - - hp2psResult = runCmdExitCode(hp2psCmd) - - actual_ps_file = qualify(name, 'ps') - - if(hp2psResult == 0): - if (os.path.exists(actual_ps_file)): - if gs_working: - gsResult = runCmdExitCode(genGSCmd(actual_ps_file)) - if (gsResult == 0): - return (True) - else: - print("hp2ps output for " + name + "is not valid PostScript") - else: return (True) # assume postscript is valid without ghostscript - else: - print("hp2ps did not generate PostScript for " + name) - return (False) - else: - print("hp2ps error when processing heap profile for " + name) - return(False) - - def check_prof_ok(name, way): - - prof_file = qualify(name,'prof') - - if not os.path.exists(prof_file): - print(prof_file + " does not exist") - return(False) - - if os.path.getsize(qualify(name,'prof')) == 0: - print(prof_file + " is empty") - return(False) - - if getTestOpts().with_namebase == None: - namebase = name - else: - namebase = getTestOpts().with_namebase - - (platform_specific, expected_prof_file) = \ - platform_wordsize_qualify(namebase, 'prof.sample') - - # sample prof file is not required - if not os.path.exists(expected_prof_file): - return True - else: - return compare_outputs(way, 'prof', - join_normalisers(normalise_whitespace,normalise_prof), \ - expected_prof_file, prof_file) - - # Compare expected output to actual output, and optionally accept the - # new output. Returns true if output matched or was accepted, false - # otherwise. - def compare_outputs(way, kind, normaliser, expected_file, actual_file): - if os.path.exists(expected_file): - expected_raw = read_no_crs(expected_file) - # print "norm:", normaliser(expected_raw) - expected_str = normaliser(expected_raw) - expected_file_for_diff = expected_file - else: - expected_str = '' - expected_file_for_diff = '/dev/null' - - actual_raw = read_no_crs(actual_file) - actual_str = normaliser(actual_raw) - - if expected_str == actual_str: - return 1 - else: - if_verbose(1, 'Actual ' + kind + ' output differs from expected:') - - if expected_file_for_diff == '/dev/null': - expected_normalised_file = '/dev/null' - else: - expected_normalised_file = expected_file + ".normalised" - write_file(expected_normalised_file, expected_str) - - actual_normalised_file = actual_file + ".normalised" - write_file(actual_normalised_file, actual_str) - - # Ignore whitespace when diffing. We should only get to this - # point if there are non-whitespace differences - # - # Note we are diffing the *actual* output, not the normalised - # output. The normalised output may have whitespace squashed - # (including newlines) so the diff would be hard to read. - # This does mean that the diff might contain changes that - # would be normalised away. - if (config.verbose >= 1): - r = os.system( 'diff -uw ' + expected_file_for_diff + \ - ' ' + actual_file ) - - # If for some reason there were no non-whitespace differences, - # then do a full diff - if r == 0: - r = os.system( 'diff -u ' + expected_file_for_diff + \ - ' ' + actual_file ) - - if config.accept and (getTestOpts().expect == 'fail' or - way in getTestOpts().expect_fail_for): - if_verbose(1, 'Test is expected to fail. Not accepting new output.') - return 0 - elif config.accept: - if_verbose(1, 'Accepting new output.') - write_file(expected_file, actual_raw) - return 1 - else: - return 0 - - - def normalise_whitespace( str ): - # Merge contiguous whitespace characters into a single space. - str = re.sub('[ \t\n]+', ' ', str) - return str - - def normalise_errmsg( str ): - # If somefile ends in ".exe" or ".exe:", zap ".exe" (for Windows) - # the colon is there because it appears in error messages; this - # hacky solution is used in place of more sophisticated filename - # mangling - str = re.sub('([^\\s])\\.exe', '\\1', str) - # normalise slashes, minimise Windows/Unix filename differences - str = re.sub('\\\\', '/', str) - # The inplace ghc's are called ghc-stage[123] to avoid filename - # collisions, so we need to normalise that to just "ghc" - str = re.sub('ghc-stage[123]', 'ghc', str) - # Error messages simetimes contain integer implementation package - str = re.sub('integer-(gmp|simple)-[0-9.]+', 'integer--', str) - return str - - # normalise a .prof file, so that we can reasonably compare it against - # a sample. This doesn't compare any of the actual profiling data, - # only the shape of the profile and the number of entries. - def normalise_prof (str): - # strip everything up to the line beginning "COST CENTRE" - str = re.sub('^(.*\n)*COST CENTRE[^\n]*\n','',str) - - # strip results for CAFs, these tend to change unpredictably - str = re.sub('[ \t]*(CAF|IDLE).*\n','',str) - - # XXX Ignore Main.main. Sometimes this appears under CAF, and - # sometimes under MAIN. - str = re.sub('[ \t]*main[ \t]+Main.*\n','',str) - - # We have somthing like this: - - # MAIN MAIN 101 0 0.0 0.0 100.0 100.0 - # k Main 204 1 0.0 0.0 0.0 0.0 - # foo Main 205 1 0.0 0.0 0.0 0.0 - # foo.bar Main 207 1 0.0 0.0 0.0 0.0 - - # then we remove all the specific profiling data, leaving only the - # cost centre name, module, and entries, to end up with this: - - # MAIN MAIN 0 - # k Main 1 - # foo Main 1 - # foo.bar Main 1 - - str = re.sub('\n([ \t]*[^ \t]+)([ \t]+[^ \t]+)([ \t]+\\d+)([ \t]+\\d+)[ \t]+([\\d\\.]+)[ \t]+([\\d\\.]+)[ \t]+([\\d\\.]+)[ \t]+([\\d\\.]+)','\n\\1 \\2 \\4',str) - return str - - def normalise_slashes_( str ): - str = re.sub('\\\\', '/', str) - return str - - def normalise_exe_( str ): - str = re.sub('\.exe', '', str) - return str - - def normalise_output( str ): - # Remove a .exe extension (for Windows) - # This can occur in error messages generated by the program. - str = re.sub('([^\\s])\\.exe', '\\1', str) - return str - - def normalise_asm( str ): - lines = str.split('\n') - # Only keep instructions and labels not starting with a dot. - metadata = re.compile('^[ \t]*\\..*$') - out = [] - for line in lines: - # Drop metadata directives (e.g. ".type") - if not metadata.match(line): - line = re.sub('@plt', '', line) - instr = line.lstrip().split() - # Drop empty lines. - if not instr: - continue - # Drop operands, except for call instructions. - elif instr[0] == 'call': - out.append(instr[0] + ' ' + instr[1]) - else: - out.append(instr[0]) - out = '\n'.join(out) - return out - - def if_verbose( n, s ): - if config.verbose >= n: - print(s) - - def if_verbose_dump( n, f ): - if config.verbose >= n: - try: - print(open(f).read()) - except: - print('') - - def rawSystem(cmd_and_args): - # We prefer subprocess.call to os.spawnv as the latter - # seems to send its arguments through a shell or something - # with the Windows (non-cygwin) python. An argument "a b c" - # turns into three arguments ["a", "b", "c"]. - - # However, subprocess is new in python 2.4, so fall back to - # using spawnv if we don't have it - cmd = cmd_and_args[0] - if have_subprocess: - return subprocess.call([strip_quotes(cmd)] + cmd_and_args[1:]) - else: - return os.spawnv(os.P_WAIT, cmd, cmd_and_args) - - # When running under native msys Python, any invocations of non-msys binaries, - # including timeout.exe, will have their arguments munged according to some - # heuristics, which leads to malformed command lines (#9626). The easiest way - # to avoid problems is to invoke through /usr/bin/cmd which sidesteps argument - # munging because it is a native msys application. - def passThroughCmd(cmd_and_args): - args = [] - # cmd needs a Windows-style path for its first argument. - args.append(cmd_and_args[0].replace('/', '\\')) - # Other arguments need to be quoted to deal with spaces. - args.extend(['"%s"' % arg for arg in cmd_and_args[1:]]) - return ["cmd", "/c", " ".join(args)] - - # Note that this doesn't handle the timeout itself; it is just used for - # commands that have timeout handling built-in. - def rawSystemWithTimeout(cmd_and_args): - if config.os == 'mingw32' and sys.executable.startswith('/usr'): - # This is only needed when running under msys python. - cmd_and_args = passThroughCmd(cmd_and_args) - r = rawSystem(cmd_and_args) - if r == 98: - # The python timeout program uses 98 to signal that ^C was pressed - stopNow() - return r - - # cmd is a complex command in Bourne-shell syntax - # e.g (cd . && 'c:/users/simonpj/darcs/HEAD/compiler/stage1/ghc-inplace' ...etc) - # Hence it must ultimately be run by a Bourne shell - # - # Mostly it invokes the command wrapped in 'timeout' thus - # timeout 300 'cd . && ...blah blah' - # so it's timeout's job to invoke the Bourne shell - # - # But watch out for the case when there is no timeout program! - # Then, when using the native Python, os.system will invoke the cmd shell - - def runCmd( cmd ): - # Format cmd using config. Example: cmd='{hpc} report A.tix' - cmd = cmd.format(**config.__dict__) - - if_verbose( 3, cmd ) - r = 0 - if config.os == 'mingw32': - # On MinGW, we will always have timeout - assert config.timeout_prog!='' - - if config.timeout_prog != '': - r = rawSystemWithTimeout([config.timeout_prog, str(config.timeout), cmd]) - else: - r = os.system(cmd) - return r << 8 - - def runCmdFor( name, cmd, timeout_multiplier=1.0 ): - # Format cmd using config. Example: cmd='{hpc} report A.tix' - cmd = cmd.format(**config.__dict__) - - if_verbose( 3, cmd ) - r = 0 - if config.os == 'mingw32': - # On MinGW, we will always have timeout - assert config.timeout_prog!='' - timeout = int(ceil(config.timeout * timeout_multiplier)) - - if config.timeout_prog != '': - if config.check_files_written: - fn = name + ".strace" - r = rawSystemWithTimeout( - ["strace", "-o", fn, "-fF", - "-e", "creat,open,chdir,clone,vfork", - config.timeout_prog, str(timeout), cmd]) - addTestFilesWritten(name, fn) - rm_no_fail(fn) - else: - r = rawSystemWithTimeout([config.timeout_prog, str(timeout), cmd]) - else: - r = os.system(cmd) - return r << 8 - - def runCmdExitCode( cmd ): - return (runCmd(cmd) >> 8); - - - # ----------------------------------------------------------------------------- - # checking for files being written to by multiple tests - - re_strace_call_end = '(\) += ([0-9]+|-1 E.*)| )$' - re_strace_unavailable = re.compile('^\) += \? $') - re_strace_pid = re.compile('^([0-9]+) +(.*)') - re_strace_clone = re.compile('^(clone\(|<... clone resumed> ).*\) = ([0-9]+)$') - re_strace_clone_unfinished = re.compile('^clone\( $') - re_strace_vfork = re.compile('^(vfork\(\)|<\.\.\. vfork resumed> \)) += ([0-9]+)$') - re_strace_vfork_unfinished = re.compile('^vfork\( $') - re_strace_chdir = re.compile('^chdir\("([^"]*)"(\) += 0| )$') - re_strace_chdir_resumed = re.compile('^<\.\.\. chdir resumed> \) += 0$') - re_strace_open = re.compile('^open\("([^"]*)", ([A-Z_|]*)(, [0-9]+)?' + re_strace_call_end) - re_strace_open_resumed = re.compile('^<... open resumed> ' + re_strace_call_end) - re_strace_ignore_sigchild = re.compile('^--- SIGCHLD \(Child exited\) @ 0 \(0\) ---$') - re_strace_ignore_sigvtalarm = re.compile('^--- SIGVTALRM \(Virtual timer expired\) @ 0 \(0\) ---$') - re_strace_ignore_sigint = re.compile('^--- SIGINT \(Interrupt\) @ 0 \(0\) ---$') - re_strace_ignore_sigfpe = re.compile('^--- SIGFPE \(Floating point exception\) @ 0 \(0\) ---$') - re_strace_ignore_sigsegv = re.compile('^--- SIGSEGV \(Segmentation fault\) @ 0 \(0\) ---$') - re_strace_ignore_sigpipe = re.compile('^--- SIGPIPE \(Broken pipe\) @ 0 \(0\) ---$') - - # Files that are read or written but shouldn't be: - # * ghci_history shouldn't be read or written by tests - # * things under package.conf.d shouldn't be written by tests - bad_file_usages = {} - - # Mapping from tests to the list of files that they write - files_written = {} - - # Mapping from tests to the list of files that they write but don't clean - files_written_not_removed = {} - - def add_bad_file_usage(name, file): - try: - if not file in bad_file_usages[name]: - bad_file_usages[name].append(file) - except: - bad_file_usages[name] = [file] - - def mkPath(curdir, path): - # Given the current full directory is 'curdir', what is the full - # path to 'path'? - return os.path.realpath(os.path.join(curdir, path)) - - def addTestFilesWritten(name, fn): - if config.use_threads: - with t.lockFilesWritten: - addTestFilesWrittenHelper(name, fn) - else: - addTestFilesWrittenHelper(name, fn) - - def addTestFilesWrittenHelper(name, fn): - started = False - working_directories = {} - - with open(fn, 'r') as f: - for line in f: - m_pid = re_strace_pid.match(line) - if m_pid: - pid = m_pid.group(1) - content = m_pid.group(2) - elif re_strace_unavailable.match(line): - next - else: - framework_fail(name, 'strace', "Can't find pid in strace line: " + line) - - m_open = re_strace_open.match(content) - m_chdir = re_strace_chdir.match(content) - m_clone = re_strace_clone.match(content) - m_vfork = re_strace_vfork.match(content) - - if not started: - working_directories[pid] = os.getcwd() - started = True - - if m_open: - file = m_open.group(1) - file = mkPath(working_directories[pid], file) - if file.endswith("ghci_history"): - add_bad_file_usage(name, file) - elif not file in ['/dev/tty', '/dev/null'] and not file.startswith("/tmp/ghc"): - flags = m_open.group(2).split('|') - if 'O_WRONLY' in flags or 'O_RDWR' in flags: - if re.match('package\.conf\.d', file): - add_bad_file_usage(name, file) - else: - try: - if not file in files_written[name]: - files_written[name].append(file) - except: - files_written[name] = [file] - elif 'O_RDONLY' in flags: - pass - else: - framework_fail(name, 'strace', "Can't understand flags in open strace line: " + line) - elif m_chdir: - # We optimistically assume that unfinished chdir's are going to succeed - dir = m_chdir.group(1) - working_directories[pid] = mkPath(working_directories[pid], dir) - elif m_clone: - working_directories[m_clone.group(2)] = working_directories[pid] - elif m_vfork: - working_directories[m_vfork.group(2)] = working_directories[pid] - elif re_strace_open_resumed.match(content): - pass - elif re_strace_chdir_resumed.match(content): - pass - elif re_strace_vfork_unfinished.match(content): - pass - elif re_strace_clone_unfinished.match(content): - pass - elif re_strace_ignore_sigchild.match(content): - pass - elif re_strace_ignore_sigvtalarm.match(content): - pass - elif re_strace_ignore_sigint.match(content): - pass - elif re_strace_ignore_sigfpe.match(content): - pass - elif re_strace_ignore_sigsegv.match(content): - pass - elif re_strace_ignore_sigpipe.match(content): - pass - else: - framework_fail(name, 'strace', "Can't understand strace line: " + line) - - def checkForFilesWrittenProblems(file): - foundProblem = False - - files_written_inverted = {} - for t in files_written.keys(): - for f in files_written[t]: - try: - files_written_inverted[f].append(t) - except: - files_written_inverted[f] = [t] - - for f in files_written_inverted.keys(): - if len(files_written_inverted[f]) > 1: - if not foundProblem: - foundProblem = True - file.write("\n") - file.write("\nSome files are written by multiple tests:\n") - file.write(" " + f + " (" + str(files_written_inverted[f]) + ")\n") - if foundProblem: - file.write("\n") - - # ----- - - if len(files_written_not_removed) > 0: - file.write("\n") - file.write("\nSome files written but not removed:\n") - tests = list(files_written_not_removed.keys()) - tests.sort() - for t in tests: - for f in files_written_not_removed[t]: - file.write(" " + t + ": " + f + "\n") - file.write("\n") - - # ----- - - if len(bad_file_usages) > 0: - file.write("\n") - file.write("\nSome bad file usages:\n") - tests = list(bad_file_usages.keys()) - tests.sort() - for t in tests: - for f in bad_file_usages[t]: - file.write(" " + t + ": " + f + "\n") - file.write("\n") - - # ----------------------------------------------------------------------------- - # checking if ghostscript is available for checking the output of hp2ps - - def genGSCmd(psfile): - return (config.gs + ' -dNODISPLAY -dBATCH -dQUIET -dNOPAUSE ' + psfile); - - def gsNotWorking(): - global gs_working - print("GhostScript not available for hp2ps tests") - - global gs_working - gs_working = 0 - if config.have_profiling: - if config.gs != '': - resultGood = runCmdExitCode(genGSCmd(config.confdir + '/good.ps')); - if resultGood == 0: - resultBad = runCmdExitCode(genGSCmd(config.confdir + '/bad.ps') + - ' >/dev/null 2>&1') - if resultBad != 0: - print("GhostScript available for hp2ps tests") - gs_working = 1; - else: - gsNotWorking(); - else: - gsNotWorking(); - else: - gsNotWorking(); - - def rm_no_fail( file ): - try: - os.remove( file ) - finally: - return - - def add_suffix( name, suffix ): - if suffix == '': - return name - else: - return name + '.' + suffix - - def add_hs_lhs_suffix(name): - if getTestOpts().c_src: - return add_suffix(name, 'c') - elif getTestOpts().cmm_src: - return add_suffix(name, 'cmm') - elif getTestOpts().objc_src: - return add_suffix(name, 'm') - elif getTestOpts().objcpp_src: - return add_suffix(name, 'mm') - elif getTestOpts().literate: - return add_suffix(name, 'lhs') - else: - return add_suffix(name, 'hs') - - def replace_suffix( name, suffix ): - base, suf = os.path.splitext(name) - return base + '.' + suffix - - def in_testdir( name ): - return (getTestOpts().testdir + '/' + name) - - def qualify( name, suff ): - return in_testdir(add_suffix(name, suff)) - - - # Finding the sample output. The filename is of the form - # - # .stdout[-][-][-ws-][-] - # - # and we pick the most specific version available. The is - # the major version of the compiler (e.g. 6.8.2 would be "6.8"). For - # more fine-grained control use if_compiler_lt(). - # - def platform_wordsize_qualify( name, suff ): - - basepath = qualify(name, suff) - - paths = [(platformSpecific, basepath + comp + vers + ws + plat) - for (platformSpecific, plat) in [(1, '-' + config.platform), - (1, '-' + config.os), - (0, '')] - for ws in ['-ws-' + config.wordsize, ''] - for comp in ['-' + config.compiler_type, ''] - for vers in ['-' + config.compiler_maj_version, '']] - - dir = glob.glob(basepath + '*') - dir = [normalise_slashes_(d) for d in dir] - - for (platformSpecific, f) in paths: - if f in dir: - return (platformSpecific,f) - - return (0, basepath) - - # Clean up prior to the test, so that we can't spuriously conclude - # that it passed on the basis of old run outputs. - def pretest_cleanup(name): - if getTestOpts().outputdir != None: - odir = in_testdir(getTestOpts().outputdir) - try: - shutil.rmtree(odir) - except: - pass - os.mkdir(odir) - - rm_no_fail(qualify(name,'interp.stderr')) - rm_no_fail(qualify(name,'interp.stdout')) - rm_no_fail(qualify(name,'comp.stderr')) - rm_no_fail(qualify(name,'comp.stdout')) - rm_no_fail(qualify(name,'run.stderr')) - rm_no_fail(qualify(name,'run.stdout')) - rm_no_fail(qualify(name,'tix')) - rm_no_fail(qualify(name,'exe.tix')) - # simple_build zaps the following: - # rm_nofail(qualify("o")) - # rm_nofail(qualify("")) - # not interested in the return code - - # ----------------------------------------------------------------------------- - # Return a list of all the files ending in '.T' below directories roots. - - def findTFiles(roots): - # It would be better to use os.walk, but that - # gives backslashes on Windows, which trip the - # testsuite later :-( - return [filename for root in roots for filename in findTFiles_(root)] - - def findTFiles_(path): - if os.path.isdir(path): - paths = [path + '/' + x for x in os.listdir(path)] - return findTFiles(paths) - elif path[-2:] == '.T': - return [path] - else: - return [] - - # ----------------------------------------------------------------------------- - # Output a test summary to the specified file object - - def summary(t, file): - - file.write('\n') - printUnexpectedTests(file, [t.unexpected_passes, t.unexpected_failures, t.unexpected_stat_failures]) - file.write('OVERALL SUMMARY for test run started at ' - + time.strftime("%c %Z", t.start_time) + '\n' - + str(datetime.timedelta(seconds= - round(time.time() - time.mktime(t.start_time)))).rjust(8) - + ' spent to go through\n' - + repr(t.total_tests).rjust(8) - + ' total tests, which gave rise to\n' - + repr(t.total_test_cases).rjust(8) - + ' test cases, of which\n' - + repr(t.n_tests_skipped).rjust(8) - + ' were skipped\n' - + '\n' - + repr(t.n_missing_libs).rjust(8) - + ' had missing libraries\n' - + repr(t.n_expected_passes).rjust(8) - + ' expected passes\n' - + repr(t.n_expected_failures).rjust(8) - + ' expected failures\n' - + '\n' - + repr(t.n_framework_failures).rjust(8) - + ' caused framework failures\n' - + repr(t.n_unexpected_passes).rjust(8) - + ' unexpected passes\n' - + repr(t.n_unexpected_failures).rjust(8) - + ' unexpected failures\n' - + repr(t.n_unexpected_stat_failures).rjust(8) - + ' unexpected stat failures\n' - + '\n') - - if t.n_unexpected_passes > 0: - file.write('Unexpected passes:\n') - printPassingTestInfosSummary(file, t.unexpected_passes) - - if t.n_unexpected_failures > 0: - file.write('Unexpected failures:\n') - printFailingTestInfosSummary(file, t.unexpected_failures) - - if t.n_unexpected_stat_failures > 0: - file.write('Unexpected stat failures:\n') - printFailingTestInfosSummary(file, t.unexpected_stat_failures) - - if config.check_files_written: - checkForFilesWrittenProblems(file) - - if stopping(): - file.write('WARNING: Testsuite run was terminated early\n') - - def printUnexpectedTests(file, testInfoss): - unexpected = [] - for testInfos in testInfoss: - directories = testInfos.keys() - for directory in directories: - tests = list(testInfos[directory].keys()) - unexpected += tests - if unexpected != []: - file.write('Unexpected results from:\n') - file.write('TEST="' + ' '.join(unexpected) + '"\n') - file.write('\n') - - def printPassingTestInfosSummary(file, testInfos): - directories = list(testInfos.keys()) - directories.sort() - maxDirLen = max(len(x) for x in directories) - for directory in directories: - tests = list(testInfos[directory].keys()) - tests.sort() - for test in tests: - file.write(' ' + directory.ljust(maxDirLen + 2) + test + \ - ' (' + ','.join(testInfos[directory][test]) + ')\n') - file.write('\n') - - def printFailingTestInfosSummary(file, testInfos): - directories = list(testInfos.keys()) - directories.sort() - maxDirLen = max(len(d) for d in directories) - for directory in directories: - tests = list(testInfos[directory].keys()) - tests.sort() - for test in tests: - reasons = testInfos[directory][test].keys() - for reason in reasons: - file.write(' ' + directory.ljust(maxDirLen + 2) + test + \ - ' [' + reason + ']' + \ - ' (' + ','.join(testInfos[directory][test][reason]) + ')\n') - file.write('\n') - - def getStdout(cmd_and_args): - if have_subprocess: - p = subprocess.Popen([strip_quotes(cmd_and_args[0])] + cmd_and_args[1:], - stdout=subprocess.PIPE, - stderr=subprocess.PIPE) - (stdout, stderr) = p.communicate() - r = p.wait() - if r != 0: - raise Exception("Command failed: " + str(cmd_and_args)) - if stderr != '': - raise Exception("stderr from command: " + str(cmd_and_args)) - return stdout - else: - raise Exception("Need subprocess to get stdout, but don't have it") -EOF -chmod 644 'ghc-test-framework/driver/testlib.py' - -mkdir -p 'ghc-test-framework/driver' -sed "s/^ //" <<"EOF" >'ghc-test-framework/driver/testutil.py' - # ----------------------------------------------------------------------------- - # Utils - def version_to_ints(v): - return [ int(x) for x in v.split('.') ] - - def version_lt(x, y): - return version_to_ints(x) < version_to_ints(y) - - def version_le(x, y): - return version_to_ints(x) <= version_to_ints(y) - - def version_gt(x, y): - return version_to_ints(x) > version_to_ints(y) - - def version_ge(x, y): - return version_to_ints(x) >= version_to_ints(y) - - def strip_quotes(s): - # Don't wrap commands to subprocess.call/Popen in quotes. - return s.strip('\'"') -EOF -chmod 644 'ghc-test-framework/driver/testutil.py' - -mkdir -p 'ghc-test-framework/mk' -sed "s/^ //" <<"EOF" >'ghc-test-framework/mk/boilerplate.mk' - - default: all - - HAVE_EVAL := NO - $(eval HAVE_EVAL := YES) - - ifeq "$(HAVE_EVAL)" "NO" - $(error Your make does not support eval. You need GNU make >= 3.81) - endif - - ifeq "$(abspath /)" "" - $(error Your make does not support abspath. You need GNU make >= 3.81) - endif - - show: - @echo '$(VALUE)="$($(VALUE))"' - - define canonicalise - # $1 = path variable - $1_CYGPATH := $$(shell $(SHELL) -c "cygpath -m '$$($1)'" 2> /dev/null) - ifneq "$$($1_CYGPATH)" "" - # We use 'override' in case we are trying to update a value given on - # the commandline (e.g. TEST_HC) - override $1 := $$($1_CYGPATH) - endif - endef - - define canonicaliseExecutable - # $1 = program path variable - ifneq "$$(shell test -x '$$($1).exe' && echo exists)" "" - # We use 'override' in case we are trying to update a value given on - # the commandline (e.g. TEST_HC) - override $1 := $$($1).exe - endif - $(call canonicalise,$1) - endef - - ifeq "$(TEST_HC)" "" - - STAGE1_GHC := $(abspath $(TOP)/../inplace/bin/ghc-stage1) - STAGE2_GHC := $(abspath $(TOP)/../inplace/bin/ghc-stage2) - STAGE3_GHC := $(abspath $(TOP)/../inplace/bin/ghc-stage3) - - ifneq "$(wildcard $(STAGE1_GHC) $(STAGE1_GHC).exe)" "" - - IMPLICIT_COMPILER = NO - IN_TREE_COMPILER = YES - ifeq "$(BINDIST)" "YES" - TEST_HC := $(abspath $(TOP)/../)/bindisttest/install dir/bin/ghc - else ifeq "$(stage)" "1" - TEST_HC := $(STAGE1_GHC) - else ifeq "$(stage)" "3" - TEST_HC := $(STAGE3_GHC) - else - # use stage2 by default - TEST_HC := $(STAGE2_GHC) - endif - - else - IMPLICIT_COMPILER = YES - IN_TREE_COMPILER = NO - TEST_HC := $(shell which ghc) - endif - - else - ifeq "$(TEST_HC)" "ghc" - IMPLICIT_COMPILER = YES - else - IMPLICIT_COMPILER = NO - endif - IN_TREE_COMPILER = NO - # We want to support both "ghc" and "/usr/bin/ghc" as values of TEST_HC - # passed in by the user, but - # which ghc == /usr/bin/ghc - # which /usr/bin/ghc == /usr/bin/ghc - # so on unix-like platforms we can just always 'which' it. - # However, on cygwin, we can't just use which: - # $ which c:/ghc/ghc-7.4.1/bin/ghc.exe - # which: no ghc.exe in (./c:/ghc/ghc-7.4.1/bin) - # so we start off by using realpath, and if that succeeds then we use - # that value. Otherwise we fall back on 'which'. - # - # Note also that we need to use 'override' in order to override a - # value given on the commandline. - TEST_HC_REALPATH := $(realpath $(TEST_HC)) - ifeq "$(TEST_HC_REALPATH)" "" - override TEST_HC := $(shell which '$(TEST_HC)') - else - override TEST_HC := $(TEST_HC_REALPATH) - endif - endif - - # We can't use $(dir ...) here as TEST_HC might be in a path - # containing spaces - BIN_ROOT = $(shell dirname '$(TEST_HC)') - - ifeq "$(IMPLICIT_COMPILER)" "YES" - find_tool = $(shell which $(1)) - else - find_tool = $(BIN_ROOT)/$(1) - endif - - ifeq "$(GHC_PKG)" "" - GHC_PKG := $(call find_tool,ghc-pkg) - endif - - ifeq "$(RUNGHC)" "" - RUNGHC := $(call find_tool,runghc) - endif - - ifeq "$(HSC2HS)" "" - HSC2HS := $(call find_tool,hsc2hs) - endif - - ifeq "$(HP2PS_ABS)" "" - HP2PS_ABS := $(call find_tool,hp2ps) - endif - - ifeq "$(HPC)" "" - HPC := $(call find_tool,hpc) - endif - - $(eval $(call canonicaliseExecutable,TEST_HC)) - ifeq "$(shell test -x '$(TEST_HC)' && echo exists)" "" - $(error Cannot find ghc: $(TEST_HC)) - endif - - $(eval $(call canonicaliseExecutable,GHC_PKG)) - ifeq "$(shell test -x '$(GHC_PKG)' && echo exists)" "" - $(error Cannot find ghc-pkg: $(GHC_PKG)) - endif - - $(eval $(call canonicaliseExecutable,HSC2HS)) - ifeq "$(shell test -x '$(HSC2HS)' && echo exists)" "" - $(error Cannot find hsc2hs: $(HSC2HS)) - endif - - $(eval $(call canonicaliseExecutable,HP2PS_ABS)) - ifeq "$(shell test -x '$(HP2PS_ABS)' && echo exists)" "" - $(error Cannot find hp2ps: $(HP2PS_ABS)) - endif - - $(eval $(call canonicaliseExecutable,HPC)) - ifeq "$(shell test -x '$(HPC)' && echo exists)" "" - $(error Cannot find hpc: $(HPC)) - endif - - # Be careful when using this. On Windows it ends up looking like - # c:/foo/bar which confuses make, as make thinks that the : is Makefile - # syntax - TOP_ABS := $(abspath $(TOP)) - $(eval $(call canonicalise,TOP_ABS)) - - GS = gs - CP = cp - RM = rm -f - PYTHON = python - ifeq "$(shell $(SHELL) -c 'python2 -c 0' 2> /dev/null && echo exists)" "exists" - PYTHON = python2 - endif - - # ----------------------------------------------------------------------------- - # configuration of TEST_HC - - # ghc-config.hs is a short Haskell program that runs ghc --info, parses - # the results, and emits a little .mk file with make bindings for the values. - # This way we cache the results for different values of $(TEST_HC) - - $(TOP)/mk/ghc-config : $(TOP)/mk/ghc-config.hs - "$(TEST_HC)" --make -o $@ $< - - empty= - space=$(empty) $(empty) - ghc-config-mk = $(TOP)/mk/ghcconfig$(subst $(space),_,$(subst :,_,$(subst /,_,$(subst \,_,$(TEST_HC))))).mk - - $(ghc-config-mk) : $(TOP)/mk/ghc-config - $(TOP)/mk/ghc-config "$(TEST_HC)" >"$@"; if [ $$? != 0 ]; then $(RM) "$@"; exit 1; fi - # If the ghc-config fails, remove $@, and fail - - ifeq "$(findstring clean,$(MAKECMDGOALS))" "" - include $(ghc-config-mk) - endif - - ifeq "$(GhcDynamic)" "YES" - ghcThWayFlags = -dynamic - ghciWayFlags = -dynamic - ghcPluginWayFlags = -dynamic - else - ghcThWayFlags = -static - ghciWayFlags = -static - ghcPluginWayFlags = -static - endif - - # ----------------------------------------------------------------------------- - - ifeq "$(HostOS)" "mingw32" - WINDOWS = YES - else - WINDOWS = NO - endif - ifeq "$(HostOS)" "darwin" - DARWIN = YES - else - DARWIN = NO - endif - -EOF -chmod 644 'ghc-test-framework/mk/boilerplate.mk' - -mkdir -p 'ghc-test-framework/mk' -sed "s/^ //" <<"EOF" >'ghc-test-framework/mk/ghc-config.hs' - import System.Environment - import System.Process - import Data.Maybe - - main = do - [ghc] <- getArgs - - info <- readProcess ghc ["+RTS", "--info"] "" - let fields = read info :: [(String,String)] - getGhcFieldOrFail fields "HostOS" "Host OS" - getGhcFieldOrFail fields "WORDSIZE" "Word size" - getGhcFieldOrFail fields "TARGETPLATFORM" "Target platform" - getGhcFieldOrFail fields "TargetOS_CPP" "Target OS" - getGhcFieldOrFail fields "TargetARCH_CPP" "Target architecture" - - info <- readProcess ghc ["--info"] "" - let fields = read info :: [(String,String)] - - getGhcFieldOrFail fields "GhcStage" "Stage" - getGhcFieldOrFail fields "GhcDebugged" "Debug on" - getGhcFieldOrFail fields "GhcWithNativeCodeGen" "Have native code generator" - getGhcFieldOrFail fields "GhcWithInterpreter" "Have interpreter" - getGhcFieldOrFail fields "GhcUnregisterised" "Unregisterised" - getGhcFieldOrFail fields "GhcWithSMP" "Support SMP" - getGhcFieldOrFail fields "GhcRTSWays" "RTS ways" - getGhcFieldOrDefault fields "GhcDynamicByDefault" "Dynamic by default" "NO" - getGhcFieldOrDefault fields "GhcDynamic" "GHC Dynamic" "NO" - getGhcFieldProgWithDefault fields "AR" "ar command" "ar" - getGhcFieldProgWithDefault fields "LLC" "LLVM llc command" "llc" - - let pkgdb_flag = case lookup "Project version" fields of - Just v - | parseVersion v >= [7,5] -> "package-db" - _ -> "package-conf" - putStrLn $ "GhcPackageDbFlag" ++ '=':pkgdb_flag - - - getGhcFieldOrFail :: [(String,String)] -> String -> String -> IO () - getGhcFieldOrFail fields mkvar key - = getGhcField fields mkvar key id (fail ("No field: " ++ key)) - - getGhcFieldOrDefault :: [(String,String)] -> String -> String -> String -> IO () - getGhcFieldOrDefault fields mkvar key deflt - = getGhcField fields mkvar key id on_fail - where - on_fail = putStrLn (mkvar ++ '=' : deflt) - - getGhcFieldProgWithDefault - :: [(String,String)] - -> String -> String -> String - -> IO () - getGhcFieldProgWithDefault fields mkvar key deflt - = getGhcField fields mkvar key fix on_fail - where - fix val = fixSlashes (fixTopdir topdir val) - topdir = fromMaybe "" (lookup "LibDir" fields) - on_fail = putStrLn (mkvar ++ '=' : deflt) - - getGhcField - :: [(String,String)] -> String -> String - -> (String -> String) - -> IO () - -> IO () - getGhcField fields mkvar key fix on_fail = - case lookup key fields of - Nothing -> on_fail - Just val -> putStrLn (mkvar ++ '=' : fix val) - - fixTopdir :: String -> String -> String - fixTopdir t "" = "" - fixTopdir t ('$':'t':'o':'p':'d':'i':'r':s) = t ++ s - fixTopdir t (c:s) = c : fixTopdir t s - - fixSlashes :: FilePath -> FilePath - fixSlashes = map f - where f '\\' = '/' - f c = c - - parseVersion :: String -> [Int] - parseVersion v = case break (== '.') v of - (n, rest) -> read n : case rest of - [] -> [] - ('.':v') -> parseVersion v' - _ -> error "bug in parseVersion" -EOF -chmod 644 'ghc-test-framework/mk/ghc-config.hs' - -mkdir -p 'ghc-test-framework/mk' -sed "s/^ //" <<"EOF" >'ghc-test-framework/mk/test.mk' - # ----------------------------------------------------------------------------- - # Examples of use: - # - # make -- run all the tests in the current directory - # make verbose -- as make test, but up the verbosity - # make accept -- run the tests, accepting the current output - # - # The following variables may be set on the make command line: - # - # TEST -- specific test to run - # TESTS -- specific tests to run (same as $TEST really) - # EXTRA_HC_OPTS -- extra flags to send to the Haskell compiler - # EXTRA_RUNTEST_OPTS -- extra flags to give the test driver - # CONFIG -- use a different configuration file - # COMPILER -- select a configuration file from config/ - # THREADS -- run n tests at once - # - # ----------------------------------------------------------------------------- - - # export the value of $MAKE for invocation in tests/driver/ - export MAKE - - RUNTESTS = $(TOP)/driver/runtests.py - COMPILER = ghc - CONFIGDIR = $(TOP)/config - CONFIG = $(CONFIGDIR)/$(COMPILER) - - ifeq "$(GhcUnregisterised)" "YES" - # Otherwise C backend generates many warnings about - # imcompatible proto casts for GCC's buitins: - # memcpy, printf, strlen. - EXTRA_HC_OPTS += -optc-fno-builtin - endif - - # TEST_HC_OPTS is passed to every invocation of TEST_HC - # in nested Makefiles - TEST_HC_OPTS = -fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -no-user-$(GhcPackageDbFlag) -rtsopts $(EXTRA_HC_OPTS) - - # The warning suppression flag below is a temporary kludge. While working with - # tests that contain tabs, please de-tab them so this flag can be eventually - # removed. See - # http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces - # for details - # - TEST_HC_OPTS += -fno-warn-tabs - - RUNTEST_OPTS = - - ifeq "$(filter $(TargetOS_CPP), cygwin32 mingw32)" "" - exeext = - else - exeext = .exe - endif - - ifneq "$(filter $(TargetOS_CPP),cygwin32 mingw32)" "" - dllext = .dll - else ifeq "$(TargetOS_CPP)" "darwin" - dllext = .dylib - else - dllext = .so - endif - - RUNTEST_OPTS += -e ghc_compiler_always_flags="'$(TEST_HC_OPTS)'" - - RUNTEST_OPTS += -e ghc_debugged=$(GhcDebugged) - - ifeq "$(GhcWithNativeCodeGen)" "YES" - RUNTEST_OPTS += -e ghc_with_native_codegen=1 - else - RUNTEST_OPTS += -e ghc_with_native_codegen=0 - endif - - GHC_PRIM_LIBDIR := $(subst library-dirs: ,,$(shell "$(GHC_PKG)" field ghc-prim library-dirs --simple-output)) - HAVE_VANILLA := $(shell if [ -f $(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.hi ]; then echo YES; else echo NO; fi) - HAVE_DYNAMIC := $(shell if [ -f $(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.dyn_hi ]; then echo YES; else echo NO; fi) - HAVE_PROFILING := $(shell if [ -f $(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.p_hi ]; then echo YES; else echo NO; fi) - - ifeq "$(HAVE_VANILLA)" "YES" - RUNTEST_OPTS += -e ghc_with_vanilla=1 - else - RUNTEST_OPTS += -e ghc_with_vanilla=0 - endif - - ifeq "$(HAVE_DYNAMIC)" "YES" - RUNTEST_OPTS += -e ghc_with_dynamic=1 - else - RUNTEST_OPTS += -e ghc_with_dynamic=0 - endif - - ifeq "$(HAVE_PROFILING)" "YES" - RUNTEST_OPTS += -e ghc_with_profiling=1 - else - RUNTEST_OPTS += -e ghc_with_profiling=0 - endif - - ifeq "$(filter thr, $(GhcRTSWays))" "thr" - RUNTEST_OPTS += -e ghc_with_threaded_rts=1 - else - RUNTEST_OPTS += -e ghc_with_threaded_rts=0 - endif - - ifeq "$(filter dyn, $(GhcRTSWays))" "dyn" - RUNTEST_OPTS += -e ghc_with_dynamic_rts=1 - else - RUNTEST_OPTS += -e ghc_with_dynamic_rts=0 - endif - - ifeq "$(GhcWithInterpreter)" "NO" - RUNTEST_OPTS += -e ghc_with_interpreter=0 - else ifeq "$(GhcStage)" "1" - RUNTEST_OPTS += -e ghc_with_interpreter=0 - else - RUNTEST_OPTS += -e ghc_with_interpreter=1 - endif - - ifeq "$(GhcUnregisterised)" "YES" - RUNTEST_OPTS += -e ghc_unregisterised=1 - else - RUNTEST_OPTS += -e ghc_unregisterised=0 - endif - - ifeq "$(GhcDynamicByDefault)" "YES" - RUNTEST_OPTS += -e ghc_dynamic_by_default=True - CABAL_MINIMAL_BUILD = --enable-shared --disable-library-vanilla - else - RUNTEST_OPTS += -e ghc_dynamic_by_default=False - CABAL_MINIMAL_BUILD = --enable-library-vanilla --disable-shared - endif - - ifeq "$(GhcDynamic)" "YES" - RUNTEST_OPTS += -e ghc_dynamic=True - CABAL_PLUGIN_BUILD = --enable-shared --disable-library-vanilla - else - RUNTEST_OPTS += -e ghc_dynamic=False - CABAL_PLUGIN_BUILD = --enable-library-vanilla --disable-shared - endif - - ifeq "$(GhcWithSMP)" "YES" - RUNTEST_OPTS += -e ghc_with_smp=1 - else - RUNTEST_OPTS += -e ghc_with_smp=0 - endif - - ifeq "$(LLC)" "" - RUNTEST_OPTS += -e ghc_with_llvm=0 - else ifneq "$(LLC)" "llc" - # If we have a real detected value for LLVM, then it really ought to work - RUNTEST_OPTS += -e ghc_with_llvm=1 - else ifneq "$(shell $(SHELL) -c 'llc --version | grep version' 2> /dev/null)" "" - RUNTEST_OPTS += -e ghc_with_llvm=1 - else - RUNTEST_OPTS += -e ghc_with_llvm=0 - endif - - ifeq "$(WINDOWS)" "YES" - RUNTEST_OPTS += -e windows=True - else - RUNTEST_OPTS += -e windows=False - endif - - ifeq "$(DARWIN)" "YES" - RUNTEST_OPTS += -e darwin=True - else - RUNTEST_OPTS += -e darwin=False - endif - - ifeq "$(IN_TREE_COMPILER)" "YES" - RUNTEST_OPTS += -e in_tree_compiler=True - else - RUNTEST_OPTS += -e in_tree_compiler=False - endif - - ifneq "$(THREADS)" "" - RUNTEST_OPTS += --threads=$(THREADS) - endif - - ifneq "$(VERBOSE)" "" - RUNTEST_OPTS += --verbose=$(VERBOSE) - endif - - ifeq "$(SKIP_PERF_TESTS)" "YES" - RUNTEST_OPTS += --skip-perf-tests - endif - - ifneq "$(CLEAN_ONLY)" "" - RUNTEST_OPTS += -e clean_only=True - else - RUNTEST_OPTS += -e clean_only=False - endif - - ifneq "$(CHECK_FILES_WRITTEN)" "" - RUNTEST_OPTS += --check-files-written - endif - - RUNTEST_OPTS += \ - --rootdir=. \ - --config=$(CONFIG) \ - -e 'config.confdir="$(CONFIGDIR)"' \ - -e 'config.platform="$(TARGETPLATFORM)"' \ - -e 'config.os="$(TargetOS_CPP)"' \ - -e 'config.arch="$(TargetARCH_CPP)"' \ - -e 'config.wordsize="$(WORDSIZE)"' \ - -e 'default_testopts.cleanup="$(CLEANUP)"' \ - -e 'config.timeout=int($(TIMEOUT)) or config.timeout' \ - -e 'config.exeext="$(exeext)"' \ - -e 'config.top="$(TOP_ABS)"' - - # Put an extra pair of quotes around program paths, - # so we don't have to in .T scripts or driver/testlib.py. - RUNTEST_OPTS += \ - -e 'config.compiler="\"$(TEST_HC)\""' \ - -e 'config.ghc_pkg="\"$(GHC_PKG)\""' \ - -e 'config.hp2ps="\"$(HP2PS_ABS)\""' \ - -e 'config.hpc="\"$(HPC)\""' \ - -e 'config.gs="\"$(GS)\""' \ - -e 'config.timeout_prog="\"$(TIMEOUT_PROGRAM)\""' - - ifneq "$(OUTPUT_SUMMARY)" "" - RUNTEST_OPTS += \ - --output-summary "$(OUTPUT_SUMMARY)" - endif - - RUNTEST_OPTS += \ - $(EXTRA_RUNTEST_OPTS) - - ifeq "$(list_broken)" "YES" - set_list_broken = -e config.list_broken=True - else - set_list_broken = - endif - - ifeq "$(fast)" "YES" - setfast = -e config.fast=1 - else - setfast = - endif - - ifeq "$(accept)" "YES" - setaccept = -e config.accept=1 - else - setaccept = - endif - - TESTS = - TEST = - WAY = - - .PHONY: all boot test verbose accept fast list_broken - - all: test - - TIMEOUT_PROGRAM = $(TOP)/timeout/install-inplace/bin/timeout$(exeext) - - boot: $(TIMEOUT_PROGRAM) - - $(TIMEOUT_PROGRAM) : - @echo "Looks like you don't have timeout, building it first..." - $(MAKE) -C $(TOP)/timeout all - - test: $(TIMEOUT_PROGRAM) - $(PYTHON) $(RUNTESTS) $(RUNTEST_OPTS) \ - $(patsubst %, --only=%, $(TEST)) \ - $(patsubst %, --only=%, $(TESTS)) \ - $(patsubst %, --way=%, $(WAY)) \ - $(patsubst %, --skipway=%, $(SKIPWAY)) \ - $(set_list_broken) \ - $(setfast) \ - $(setaccept) - - verbose: test - - accept: - $(MAKE) accept=YES - - fast: - $(MAKE) fast=YES - - list_broken: - $(MAKE) list_broken=YES - -EOF -chmod 644 'ghc-test-framework/mk/test.mk' - -mkdir -p 'ghc-test-framework/timeout' -sed "s/^ //" <<"EOF" >'ghc-test-framework/timeout/Makefile' - TOP = .. - - # If we're cleaning then we don't want to do all the GHC detection hardwork, - # and we certainly don't want to fail if GHC etc can't be found! - # However, we can't just put this conditional in boilerplate.mk, as - # some of the tests have a "clean" makefile target that relies on GHC_PKG - # being defined. - ifneq "$(MAKECMDGOALS)" "clean" - ifneq "$(MAKECMDGOALS)" "distclean" - ifneq "$(MAKECMDGOALS)" "maintainer-clean" - - include $(TOP)/mk/boilerplate.mk - - TIMEOUT_PROGRAM = install-inplace/bin/timeout$(exeext) - - PREFIX := $(abspath install-inplace) - $(eval $(call canonicalise,PREFIX)) - - ifneq "$(GCC)" "" - WITH_GCC = --with-gcc='$(GCC)' - endif - - ifeq "$(WINDOWS)" "NO" - # Use a python timeout program, so that we don't have to worry about - # whether or not the compiler we're testing has built the timeout - # program correctly - $(TIMEOUT_PROGRAM): timeout.py - rm -rf install-inplace - mkdir install-inplace - mkdir install-inplace/bin - cp $< $@.py - echo '#!/bin/sh' > $@ - echo 'exec "${PYTHON}" $$0.py "$$@"' >> $@ - chmod +x $@ - else - # The python timeout program doesn't work on mingw, so we still use the - # Haskell program on Windows - $(TIMEOUT_PROGRAM): timeout.hs - rm -rf install-inplace - '$(TEST_HC)' --make Setup - ./Setup configure --with-compiler='$(TEST_HC)' \ - --with-hc-pkg='$(GHC_PKG)' \ - --with-hsc2hs='$(HSC2HS)' \ - $(WITH_GCC) \ - --ghc-option=-threaded --prefix='$(PREFIX)' - ./Setup build - ./Setup install - endif - - boot all :: calibrate.out $(TIMEOUT_PROGRAM) - - calibrate.out: - $(RM) -f TimeMe.o TimeMe.hi TimeMe TimeMe.exe - $(PYTHON) calibrate '$(GHC_STAGE1)' > $@ - # We use stage 1 to do the calibration, as stage 2 may not exist. - # This isn't necessarily the compiler we'll be running the testsuite - # with, but it's really the performance of the machine that we're - # interested in - - endif - endif - endif - - clean distclean maintainer-clean: - -./Setup clean - $(RM) -rf install-inplace - $(RM) -f calibrate.out - $(RM) -f Setup Setup.exe Setup.hi Setup.o - -EOF -chmod 644 'ghc-test-framework/timeout/Makefile' - -mkdir -p 'ghc-test-framework/timeout' -sed "s/^ //" <<"EOF" >'ghc-test-framework/timeout/Setup.hs' - module Main (main) where - - import Distribution.Simple - - main :: IO () - main = defaultMain -EOF -chmod 644 'ghc-test-framework/timeout/Setup.hs' - -mkdir -p 'ghc-test-framework/timeout' -sed "s/^ //" <<"EOF" >'ghc-test-framework/timeout/TimeMe.hs' - module Main (main) where - - import System.IO - - main = hPutStr stderr "" - -EOF -chmod 644 'ghc-test-framework/timeout/TimeMe.hs' - -mkdir -p 'ghc-test-framework/timeout' -sed "s/^ //" <<"EOF" >'ghc-test-framework/timeout/WinCBindings.hsc' - {-# LANGUAGE CPP, ForeignFunctionInterface #-} - module WinCBindings where - - #if defined(mingw32_HOST_OS) - - import Foreign - import System.Win32.File - import System.Win32.Types - - #include - - type LPPROCESS_INFORMATION = Ptr PROCESS_INFORMATION - data PROCESS_INFORMATION = PROCESS_INFORMATION - { piProcess :: HANDLE - , piThread :: HANDLE - , piProcessId :: DWORD - , piThreadId :: DWORD - } deriving Show - - instance Storable PROCESS_INFORMATION where - sizeOf = const #size PROCESS_INFORMATION - alignment = sizeOf - poke buf pi = do - (#poke PROCESS_INFORMATION, hProcess) buf (piProcess pi) - (#poke PROCESS_INFORMATION, hThread) buf (piThread pi) - (#poke PROCESS_INFORMATION, dwProcessId) buf (piProcessId pi) - (#poke PROCESS_INFORMATION, dwThreadId) buf (piThreadId pi) - - peek buf = do - vhProcess <- (#peek PROCESS_INFORMATION, hProcess) buf - vhThread <- (#peek PROCESS_INFORMATION, hThread) buf - vdwProcessId <- (#peek PROCESS_INFORMATION, dwProcessId) buf - vdwThreadId <- (#peek PROCESS_INFORMATION, dwThreadId) buf - return $ PROCESS_INFORMATION { - piProcess = vhProcess, - piThread = vhThread, - piProcessId = vdwProcessId, - piThreadId = vdwThreadId} - - type LPSTARTUPINFO = Ptr STARTUPINFO - data STARTUPINFO = STARTUPINFO - { siCb :: DWORD - , siDesktop :: LPTSTR - , siTitle :: LPTSTR - , siX :: DWORD - , siY :: DWORD - , siXSize :: DWORD - , siYSize :: DWORD - , siXCountChars :: DWORD - , siYCountChars :: DWORD - , siFillAttribute :: DWORD - , siFlags :: DWORD - , siShowWindow :: WORD - , siStdInput :: HANDLE - , siStdOutput :: HANDLE - , siStdError :: HANDLE - } deriving Show - - instance Storable STARTUPINFO where - sizeOf = const #size STARTUPINFO - alignment = sizeOf - poke buf si = do - (#poke STARTUPINFO, cb) buf (siCb si) - (#poke STARTUPINFO, lpDesktop) buf (siDesktop si) - (#poke STARTUPINFO, lpTitle) buf (siTitle si) - (#poke STARTUPINFO, dwX) buf (siX si) - (#poke STARTUPINFO, dwY) buf (siY si) - (#poke STARTUPINFO, dwXSize) buf (siXSize si) - (#poke STARTUPINFO, dwYSize) buf (siYSize si) - (#poke STARTUPINFO, dwXCountChars) buf (siXCountChars si) - (#poke STARTUPINFO, dwYCountChars) buf (siYCountChars si) - (#poke STARTUPINFO, dwFillAttribute) buf (siFillAttribute si) - (#poke STARTUPINFO, dwFlags) buf (siFlags si) - (#poke STARTUPINFO, wShowWindow) buf (siShowWindow si) - (#poke STARTUPINFO, hStdInput) buf (siStdInput si) - (#poke STARTUPINFO, hStdOutput) buf (siStdOutput si) - (#poke STARTUPINFO, hStdError) buf (siStdError si) - - peek buf = do - vcb <- (#peek STARTUPINFO, cb) buf - vlpDesktop <- (#peek STARTUPINFO, lpDesktop) buf - vlpTitle <- (#peek STARTUPINFO, lpTitle) buf - vdwX <- (#peek STARTUPINFO, dwX) buf - vdwY <- (#peek STARTUPINFO, dwY) buf - vdwXSize <- (#peek STARTUPINFO, dwXSize) buf - vdwYSize <- (#peek STARTUPINFO, dwYSize) buf - vdwXCountChars <- (#peek STARTUPINFO, dwXCountChars) buf - vdwYCountChars <- (#peek STARTUPINFO, dwYCountChars) buf - vdwFillAttribute <- (#peek STARTUPINFO, dwFillAttribute) buf - vdwFlags <- (#peek STARTUPINFO, dwFlags) buf - vwShowWindow <- (#peek STARTUPINFO, wShowWindow) buf - vhStdInput <- (#peek STARTUPINFO, hStdInput) buf - vhStdOutput <- (#peek STARTUPINFO, hStdOutput) buf - vhStdError <- (#peek STARTUPINFO, hStdError) buf - return $ STARTUPINFO { - siCb = vcb, - siDesktop = vlpDesktop, - siTitle = vlpTitle, - siX = vdwX, - siY = vdwY, - siXSize = vdwXSize, - siYSize = vdwYSize, - siXCountChars = vdwXCountChars, - siYCountChars = vdwYCountChars, - siFillAttribute = vdwFillAttribute, - siFlags = vdwFlags, - siShowWindow = vwShowWindow, - siStdInput = vhStdInput, - siStdOutput = vhStdOutput, - siStdError = vhStdError} - - foreign import stdcall unsafe "windows.h WaitForSingleObject" - waitForSingleObject :: HANDLE -> DWORD -> IO DWORD - - cWAIT_ABANDONED :: DWORD - cWAIT_ABANDONED = #const WAIT_ABANDONED - - cWAIT_OBJECT_0 :: DWORD - cWAIT_OBJECT_0 = #const WAIT_OBJECT_0 - - cWAIT_TIMEOUT :: DWORD - cWAIT_TIMEOUT = #const WAIT_TIMEOUT - - foreign import stdcall unsafe "windows.h GetExitCodeProcess" - getExitCodeProcess :: HANDLE -> LPDWORD -> IO BOOL - - foreign import stdcall unsafe "windows.h TerminateJobObject" - terminateJobObject :: HANDLE -> UINT -> IO BOOL - - foreign import stdcall unsafe "windows.h AssignProcessToJobObject" - assignProcessToJobObject :: HANDLE -> HANDLE -> IO BOOL - - foreign import stdcall unsafe "windows.h CreateJobObjectW" - createJobObjectW :: LPSECURITY_ATTRIBUTES -> LPCTSTR -> IO HANDLE - - foreign import stdcall unsafe "windows.h CreateProcessW" - createProcessW :: LPCTSTR -> LPTSTR - -> LPSECURITY_ATTRIBUTES -> LPSECURITY_ATTRIBUTES - -> BOOL -> DWORD -> LPVOID -> LPCTSTR -> LPSTARTUPINFO - -> LPPROCESS_INFORMATION -> IO BOOL - - #endif - -EOF -chmod 644 'ghc-test-framework/timeout/WinCBindings.hsc' - -mkdir -p 'ghc-test-framework/timeout' -sed "s/^ //" <<"EOF" >'ghc-test-framework/timeout/calibrate' - #!/usr/bin/env python - - import math - import os - from os import * - from sys import * - try: - from resource import * - except: - # We don't have resource, so this is a non-UNIX machine. - # It's probably a reasonable modern x86/x86_64 machines, so we'd - # probably calibrate to 300 anyway; thus just print 300. - print(300) - exit(0) - - compiler = argv[1] - compiler_name = os.path.basename(compiler) - - spawnl(os.P_WAIT, compiler, - compiler_name, 'TimeMe.hs', '-o', 'TimeMe', '-O2') - spawnl(os.P_WAIT, './TimeMe', 'TimeMe') - - xs = getrusage(RUSAGE_CHILDREN); - x = int(math.ceil(xs[0] + xs[1])) - if x < 1: - x = 1 - print (300*x) - -EOF -chmod 644 'ghc-test-framework/timeout/calibrate' - -mkdir -p 'ghc-test-framework/timeout' -sed "s/^ //" <<"EOF" >'ghc-test-framework/timeout/timeout.cabal' - Name: timeout - Version: 1 - Copyright: GHC Team - License: BSD3 - Author: GHC Team - Maintainer: GHC Team - Synopsis: timout utility - Description: timeout utility - Category: Development - build-type: Simple - cabal-version: >=1.2 - - Executable timeout - Main-Is: timeout.hs - Other-Modules: WinCBindings - Extensions: CPP - Build-Depends: base, process - if os(windows) - Build-Depends: Win32 - else - Build-Depends: unix - -EOF -chmod 644 'ghc-test-framework/timeout/timeout.cabal' - -mkdir -p 'ghc-test-framework/timeout' -sed "s/^ //" <<"EOF" >'ghc-test-framework/timeout/timeout.hs' - {-# OPTIONS -cpp #-} - module Main where - - import Control.Concurrent (forkIO, threadDelay) - import Control.Concurrent.MVar (putMVar, takeMVar, newEmptyMVar) - import Control.Monad - import Control.Exception - import Data.Maybe (isNothing) - import System.Environment (getArgs) - import System.Exit - import System.IO (hPutStrLn, stderr) - - #if !defined(mingw32_HOST_OS) - import System.Posix hiding (killProcess) - import System.IO.Error hiding (try,catch) - #endif - - #if defined(mingw32_HOST_OS) - import System.Process - import WinCBindings - import Foreign - import System.Win32.DebugApi - import System.Win32.Types - #endif - - main :: IO () - main = do - args <- getArgs - case args of - [secs,cmd] -> - case reads secs of - [(secs', "")] -> run secs' cmd - _ -> ((>> exitFailure) . hPutStrLn stderr) ("Can't parse " ++ show secs ++ " as a number of seconds") - _ -> ((>> exitFailure) . hPutStrLn stderr) ("Bad arguments " ++ show args) - - timeoutMsg :: String - timeoutMsg = "Timeout happened...killing process..." - - run :: Int -> String -> IO () - #if !defined(mingw32_HOST_OS) - run secs cmd = do - m <- newEmptyMVar - mp <- newEmptyMVar - installHandler sigINT (Catch (putMVar m Nothing)) Nothing - forkIO $ do threadDelay (secs * 1000000) - putMVar m Nothing - forkIO $ do ei <- try $ do pid <- systemSession cmd - return pid - putMVar mp ei - case ei of - Left _ -> return () - Right pid -> do - r <- getProcessStatus True False pid - putMVar m r - ei_pid_ph <- takeMVar mp - case ei_pid_ph of - Left e -> do hPutStrLn stderr - ("Timeout:\n" ++ show (e :: IOException)) - exitWith (ExitFailure 98) - Right pid -> do - r <- takeMVar m - case r of - Nothing -> do - hPutStrLn stderr timeoutMsg - killProcess pid - exitWith (ExitFailure 99) - Just (Exited r) -> exitWith r - Just (Terminated s) -> raiseSignal s - Just _ -> exitWith (ExitFailure 1) - - systemSession cmd = - forkProcess $ do - createSession - executeFile "/bin/sh" False ["-c", cmd] Nothing - -- need to use exec() directly here, rather than something like - -- System.Process.system, because we are in a forked child and some - -- pthread libraries get all upset if you start doing certain - -- things in a forked child of a pthread process, such as forking - -- more threads. - - killProcess pid = do - ignoreIOExceptions (signalProcessGroup sigTERM pid) - checkReallyDead 10 - where - checkReallyDead 0 = hPutStrLn stderr "checkReallyDead: Giving up" - checkReallyDead (n+1) = - do threadDelay (3*100000) -- 3/10 sec - m <- tryJust (guard . isDoesNotExistError) $ - getProcessStatus False False pid - case m of - Right Nothing -> return () - Left _ -> return () - _ -> do - ignoreIOExceptions (signalProcessGroup sigKILL pid) - checkReallyDead n - - ignoreIOExceptions :: IO () -> IO () - ignoreIOExceptions io = io `catch` ((\_ -> return ()) :: IOException -> IO ()) - - #else - run secs cmd = - let escape '\\' = "\\\\" - escape '"' = "\\\"" - escape c = [c] - cmd' = "sh -c \"" ++ concatMap escape cmd ++ "\"" in - alloca $ \p_startupinfo -> - alloca $ \p_pi -> - withTString cmd' $ \cmd'' -> - do job <- createJobObjectW nullPtr nullPtr - let creationflags = 0 - b <- createProcessW nullPtr cmd'' nullPtr nullPtr True - creationflags - nullPtr nullPtr p_startupinfo p_pi - unless b $ errorWin "createProcessW" - pi <- peek p_pi - assignProcessToJobObject job (piProcess pi) - resumeThread (piThread pi) - - -- The program is now running - - let handle = piProcess pi - let millisecs = secs * 1000 - rc <- waitForSingleObject handle (fromIntegral millisecs) - if rc == cWAIT_TIMEOUT - then do hPutStrLn stderr timeoutMsg - terminateJobObject job 99 - exitWith (ExitFailure 99) - else alloca $ \p_exitCode -> - do r <- getExitCodeProcess handle p_exitCode - if r then do ec <- peek p_exitCode - let ec' = if ec == 0 - then ExitSuccess - else ExitFailure $ fromIntegral ec - exitWith ec' - else errorWin "getExitCodeProcess" - #endif - -EOF -chmod 644 'ghc-test-framework/timeout/timeout.hs' - -mkdir -p 'ghc-test-framework/timeout' -sed "s/^ //" <<"EOF" >'ghc-test-framework/timeout/timeout.py' - #!/usr/bin/env python - - try: - - import errno - import os - import signal - import sys - import time - - secs = int(sys.argv[1]) - cmd = sys.argv[2] - - def killProcess(pid): - os.killpg(pid, signal.SIGKILL) - for x in range(10): - try: - time.sleep(0.3) - r = os.waitpid(pid, os.WNOHANG) - if r == (0, 0): - os.killpg(pid, signal.SIGKILL) - else: - return - except OSError as e: - if e.errno == errno.ECHILD: - return - else: - raise e - - pid = os.fork() - if pid == 0: - # child - os.setpgrp() - os.execvp('/bin/sh', ['/bin/sh', '-c', cmd]) - else: - # parent - def handler(signum, frame): - sys.stderr.write('Timeout happened...killing process...\n') - killProcess(pid) - sys.exit(99) - old = signal.signal(signal.SIGALRM, handler) - signal.alarm(secs) - (pid2, res) = os.waitpid(pid, 0) - if (os.WIFEXITED(res)): - sys.exit(os.WEXITSTATUS(res)) - else: - sys.exit(res) - - except KeyboardInterrupt: - sys.exit(98) - except: - raise - -EOF -chmod 644 'ghc-test-framework/timeout/timeout.py' diff --git a/tools/run-tests b/tools/run-tests deleted file mode 100644 --- a/tools/run-tests +++ /dev/null @@ -1,52 +0,0 @@ -#!/bin/sh -# run all of the tests under the `tests` directory using the GHC test -# framework; for more info about this framework, see: -# https://ghc.haskell.org/trac/ghc/wiki/Building/RunningTests -# -# arguments received by this script are passed as arguments to the `make` -# invocation that initiates the tests -set -e - -# check if `-package-db` is supported (didn't exist until 1.20) -# note that we don't use `-package-db` directly because older versions will -# interpret it as `-package -db` -if ghc 2>&1 -no-user-package-db | - grep >/dev/null 2>&1 "ghc: unrecognised flags: -no-user-package-db" -then db=conf -else db=db -fi - -[ -z "$HSFLAGS" ] || HSFLAGS=\ $HSFLAGS -HSFLAGS="-package-$db ../dist/package.conf.inplace$HSFLAGS" -HSFLAGS="-optP-include -optP../dist/build/autogen/cabal_macros.h $HSFLAGS" -export HSFLAGS - -# extract the test framework if needed -[ -f dist/testsuite/ghc-test-framework.ok ] || ( - set -e - mkdir -p dist/testsuite - cd dist/testsuite - rm -fr ghc-test-framework - sh - touch ghc-test-framework.ok -) dist/testsuite/Makefile \ - "s|^TOP=.*$|TOP=../dist/testsuite/ghc-test-framework|" \ - tests/Makefile - -cd tests -make -f ../dist/testsuite/Makefile WAY=normal EXTRA_HC_OPTS="$HSFLAGS" "$@" | - tee ../dist/testsuite/test.out - -# since the test framework doesn't report an exit status, we need to manually -# find out whether the test had any failures> -{ - grep '^ *0 had missing libraries$' ../dist/testsuite/test.out - grep '^ *0 caused framework failures$' ../dist/testsuite/test.out - grep '^ *0 unexpected passes$' ../dist/testsuite/test.out - grep '^ *0 unexpected failures$' ../dist/testsuite/test.out - grep '^ *0 unexpected stat failures$' ../dist/testsuite/test.out -} >/dev/null 2>/dev/null