mach

  1{-# LANGUAGE TypeApplications #-}
  2
  3module Golden (eqivTests) where
  4
  5import Control.Applicative ((<|>))
  6import Control.Exception (catch)
  7import Mach.Error (MakeErr)
  8import Mach.Main (run)
  9import System.Directory (withCurrentDirectory)
 10import System.Exit (ExitCode (ExitFailure, ExitSuccess))
 11import System.FilePath
 12import System.IO (IOMode (WriteMode), hClose, hGetContents, openFile)
 13import System.Process
 14  ( StdStream (CreatePipe, UseHandle),
 15    createPipe,
 16    createProcess,
 17    cwd,
 18    proc,
 19    std_err,
 20    std_out,
 21    waitForProcess,
 22  )
 23import Test.Tasty
 24import Test.Tasty.Golden.Advanced
 25import Util
 26
 27-- The golden test do not use a golden expected file but instead compare
 28-- the "output" of a reference make(1) implementation and mach. The
 29-- output is defined by 'MakeResult'. Presently it includes:
 30--
 31--   • A boolean indicating a succesfully exit
 32--   • Standard output as a 'String'
 33--   • A 'FilePAth' which refers to the dir where make(1) was invoked
 34--
 35type MakeResult = (Bool, String, FilePath)
 36
 37runMach :: [String] -> FilePath -> IO MakeResult
 38runMach flags skel = do
 39  destDir <- prepTempDir "actual" skel
 40
 41  (readEnd, writeEnd) <- createPipe
 42  success <-
 43    catch @MakeErr
 44      ( do
 45          e <- withCurrentDirectory destDir $ run writeEnd flags
 46          case e of
 47            ExitSuccess -> pure True
 48            _ -> pure False
 49      )
 50      (const $ pure False)
 51
 52  -- The readEnd is semi-close by hGetContents, should be
 53  -- closed once the entire handle content has been read.
 54  out <- hGetContents readEnd <* hClose writeEnd
 55
 56  pure (success, out, destDir)
 57
 58runGolden :: [String] -> FilePath -> IO MakeResult
 59runGolden flags skel = do
 60  destDir <- prepTempDir "golden" skel
 61  devNull <- openFile "/dev/null" WriteMode
 62
 63  (_, Just hout, _, p) <-
 64    createProcess
 65      (proc "pdpmake" flags)
 66        { cwd = Just destDir,
 67          std_out = CreatePipe,
 68          std_err = UseHandle devNull
 69        }
 70
 71  ret <- waitForProcess p <* hClose devNull
 72  out <- hGetContents hout
 73  case ret of
 74    ExitSuccess -> pure (True, out, destDir)
 75    ExitFailure _ -> pure (False, out, destDir)
 76
 77compareRuns :: MakeResult -> MakeResult -> IO (Maybe String)
 78compareRuns (succG, outG, fpG) (succA, outA, fpA) = do
 79  out <- compareStdout
 80  dir <- compareDirectory
 81  ret <- pure compareExit
 82  pure (out <|> dir <|> ret)
 83  where
 84    compareStdout :: IO (Maybe String)
 85    compareStdout =
 86      pure $
 87        if outG /= outA
 88          then Just "standard output differs"
 89          else Nothing
 90
 91    compareDirectory :: IO (Maybe String)
 92    compareDirectory = do
 93      let diffArgs = ["-upr", fpG, fpA]
 94      (_, Just hout, _, p) <-
 95        createProcess
 96          (proc "diff" diffArgs) {std_out = CreatePipe}
 97
 98      exitCode <- waitForProcess p
 99      case exitCode of
100        ExitSuccess -> pure Nothing
101        ExitFailure _ -> Just <$> hGetContents hout
102
103    compareExit :: Maybe String
104    compareExit =
105      case (succG, succA) of
106        (True, False) -> Just "expected zero exit"
107        (False, True) -> Just "expected non-zero exit"
108        _ -> Nothing
109
110runMake :: TestName -> [String] -> FilePath -> TestTree
111runMake name flags makeDir =
112  goldenTest
113    name
114    (runGolden flags makeDir)
115    (runMach flags makeDir)
116    compareRuns
117    (\_ -> pure ())
118
119------------------------------------------------------------------------
120
121runTest :: String -> [String] -> TestTree
122runTest name flags =
123  runMake
124    (if null flags then name else name ++ " [" ++ unwords flags ++ "]")
125    flags
126    ("test" </> "golden" </> name)
127
128eqivTests :: TestTree
129eqivTests =
130  testGroup
131    "eviqTests"
132    [ runTest "expand-delayed" [],
133      runTest "expand-immediate" [],
134      runTest "expand-conditional" [],
135      runTest "default-rule" [],
136      runTest "include-makefile" [],
137      runTest "single-suffix-inference" [],
138      runTest "double-suffix-inference" [],
139      runTest "silent-exec" [],
140      runTest "ignore-error" [],
141      runTest "ignore-error-silent" [],
142      runTest "silent-selected-targets" [],
143      runTest "silent-all" [],
144      runTest "silent-all-cmdline" ["-s"],
145      runTest "expand-append" [],
146      runTest "substitute-expand" [],
147      runTest "builtin-c-compilation1" [],
148      runTest "builtin-c-compilation2" [],
149      runTest "silent-append" [],
150      runTest "ignore-all" [],
151      runTest "ignore-single" [],
152      runTest "ignore-all-cmdline" ["-i"],
153      runTest "continue-execution" [],
154      runTest "continue-execution" ["-k", "-i"],
155      runTest "continue-execution" ["-S", "-k", "-i"],
156      runTest "continue-execution" ["-k", "-i", "-S"],
157      runTest "continue-execution" ["-k", "-i", "-S", "-k"],
158      runTest "continue-execution" ["-k"],
159      runTest "dry-run" ["-n"],
160      runTest "dry-run-with-exec" ["-n"],
161      runTest "no-builtins" ["-r"],
162      runTest "lvalue-macro" []
163      -- TODO: Need to support $(MAKE) for this.
164      -- runTest "append-prerequisites",
165    ]