diff --git a/cabal.project b/cabal.project index 12f71242..6ae64634 100644 --- a/cabal.project +++ b/cabal.project @@ -13,3 +13,7 @@ if !os(windows) if !os(windows) executable-dynamic: True +source-repository-package + type: git + location: https://github.com/Saizan/hie-bios.git + branch: new-loadstyles diff --git a/haskell-debugger.cabal b/haskell-debugger.cabal index 1ec007cc..a2f13637 100644 --- a/haskell-debugger.cabal +++ b/haskell-debugger.cabal @@ -155,7 +155,7 @@ library hs-source-dirs: haskell-debugger default-language: GHC2021 -library dap +library dap-server import: warnings exposed-modules: Development.Debug.Adapter.Breakpoints, Development.Debug.Adapter.Stepping, @@ -222,7 +222,7 @@ executable hdb unordered-containers >= 0.2.19 && < 0.3, haskell-debugger, - haskell-debugger:dap, + haskell-debugger:dap-server, hie-bios, prettyprinter ^>= 1.7.0, co-log-core >= 0.3.2.5 && < 0.4, diff --git a/hdb-dap/Development/Debug/Session/Setup.hs b/hdb-dap/Development/Debug/Session/Setup.hs index 93ea2346..be840c1b 100644 --- a/hdb-dap/Development/Debug/Session/Setup.hs +++ b/hdb-dap/Development/Debug/Session/Setup.hs @@ -186,8 +186,9 @@ hieBiosFlags cradle root relTarget = runExceptT $ do -- because hie.yaml may invoke programs relative to the root (e.g. GHC's hie.yaml does) -- (HIE.getCompilerOptions depends on CWD being the proper root dir) let compilerOpts = liftIO $ withCurrentDirectory root $ +-- TODO version this properly #if MIN_VERSION_hie_bios(0,14,0) - HIE.getCompilerOptions target (HIE.LoadWithContext [target]) cradle + HIE.getCompilerOptions (HIE.TargetWithContext target [target]) HIE.LoadUnitsFromCradle cradle #else HIE.getCompilerOptions target [] cradle #endif diff --git a/test/golden/T130b/T130b.ghc-914.hdb-stdout b/test/golden/T130b/T130b.ghc-914.hdb-stdout index 1de0d335..a401617a 100644 --- a/test/golden/T130b/T130b.ghc-914.hdb-stdout +++ b/test/golden/T130b/T130b.ghc-914.hdb-stdout @@ -1,4 +1,5 @@ -[1 of 2] Compiling Main ( /app/Main.hs, interpreted )[T130b-0.1.0.0-inplace-T130b] +[1 of 3] Compiling Lib ( /lib/Lib.hs, interpreted )[T130b-0.1.0.0-inplace] +[2 of 3] Compiling Main ( /app/Main.hs, interpreted )[T130b-0.1.0.0-inplace-T130b] (hdb) MyType () (hdb) Exiting... diff --git a/test/golden/T135/hie.yaml b/test/golden/T135/hie.yaml index 343dd937..6b9e86b2 100644 --- a/test/golden/T135/hie.yaml +++ b/test/golden/T135/hie.yaml @@ -1,6 +1,5 @@ cradle: cabal: - - path: "./mylib" - component: "lib:mylib" + #we want mylib to be an external package, so we don't list it in the cradle. - path: "./myapp/" component: "myapp" diff --git a/test/golden/T237/hie.yaml b/test/golden/T237/hie.yaml new file mode 100644 index 00000000..30b30e33 --- /dev/null +++ b/test/golden/T237/hie.yaml @@ -0,0 +1,5 @@ +cradle: + cabal: + components: + - path: "app/" + component: "exe:T237" diff --git a/test/golden/self-debug-cli/cabal.project b/test/golden/self-debug-cli/cabal.project new file mode 100644 index 00000000..e6fdbadb --- /dev/null +++ b/test/golden/self-debug-cli/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/test/golden/self-debug-cli/debuggee.cabal b/test/golden/self-debug-cli/debuggee.cabal new file mode 100644 index 00000000..c6317c94 --- /dev/null +++ b/test/golden/self-debug-cli/debuggee.cabal @@ -0,0 +1,20 @@ +cabal-version: 3.0 +name: debuggee +version: 0.1.0.0 +-- synopsis: +-- description: +author: +maintainer: +-- copyright: +build-type: Simple +extra-doc-files: CHANGELOG.md +-- extra-source-files: + + +executable debuggee + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base + hs-source-dirs: . + default-language: Haskell2010 diff --git a/test/haskell/Main.hs b/test/haskell/Main.hs index 8d149636..d3b84f37 100644 --- a/test/haskell/Main.hs +++ b/test/haskell/Main.hs @@ -120,7 +120,10 @@ mkGoldenTest keepTmpDirs inheritedEnv flags path = goldenVsStringComparing testN noTmpDir = ".no-tmp-dir" `isInfixOf` testName topAction :: IO LBS.ByteString - topAction | noTmpDir = testAction path =<< getCurrentDirectory -- a bit dangerous! used in the self-debug-cli test + topAction | noTmpDir = do + cwd <- getCurrentDirectory -- a bit dangerous! used in the self-debug-cli test + withTmpDirFromRepo keepTmpDirs cwd (testAction path) + | otherwise = withHermeticDir keepTmpDirs (takeDirectory path) (testAction (takeFileName path)) diff --git a/test/haskell/Test/Integration/MultiHomeUnit.hs b/test/haskell/Test/Integration/MultiHomeUnit.hs index c4df067b..0c283ff9 100644 --- a/test/haskell/Test/Integration/MultiHomeUnit.hs +++ b/test/haskell/Test/Integration/MultiHomeUnit.hs @@ -6,6 +6,7 @@ module Test.Integration.MultiHomeUnit (multiHomeUnitTests) where import Test.DAP import Test.Tasty import Test.Tasty.HUnit +import System.FilePath (()) #ifdef mingw32_HOST_OS import Test.Tasty.ExpectedFailure #endif @@ -16,37 +17,38 @@ multiHomeUnitTests = ignoreTestBecause "Needs to be fixed for Windows (#199)" $ #endif testGroup "DAP.Integration.MultiHomeUnit" - [ testCase "should run program to the end" runToTheEnd - , testCase "should stop at break-point in the same home unit" sameHomeUnitBP - , testCase "should stop at break-point in different home unit 1" otherHomeUnitBP1 - , testCase "should stop at break-point in different home unit 2" otherHomeUnitBP2 + [testGroup dirname [ testCase "should run program to the end" $ runToTheEnd dirname + , testCase "should stop at break-point in the same home unit" $ sameHomeUnitBP dirname + , testCase "should stop at break-point in different home unit 1" $ otherHomeUnitBP1 dirname + , testCase "should stop at break-point in different home unit 2" $ otherHomeUnitBP2 dirname + ] | + dirname <- ["cabal-mhu1","T38"] ] - -withCommonSetup :: (FilePath -> TestDAP ()) -> Assertion -withCommonSetup test = - withTestDAPServer "test/integration/cabal-mhu1" [] $ \test_dir server -> +withCommonSetup :: (FilePath -> TestDAP ()) -> String -> Assertion +withCommonSetup test dirname = + withTestDAPServer ("test/integration" dirname) [] $ \test_dir server -> withTestDAPServerClient server $ do test test_dir disconnect -runToTheEnd :: Assertion +runToTheEnd :: String -> Assertion runToTheEnd = withCommonSetup $ \test_dir -> do let cfg = mkLaunchConfig test_dir "bar/app/Main.hs" runToEnd cfg -sameHomeUnitBP :: Assertion +sameHomeUnitBP :: String -> Assertion sameHomeUnitBP = withCommonSetup $ \test_dir -> do let cfg = mkLaunchConfig test_dir "bar/app/Main.hs" hitBreakpointWith cfg 8 -otherHomeUnitBP1 :: Assertion +otherHomeUnitBP1 :: String -> Assertion otherHomeUnitBP1 = withCommonSetup $ \test_dir -> do -- Use bar/app/Main.hs as the entry file; set a breakpoint in a -- *different* home unit (bar/src/Bar.hs). let cfg = mkLaunchConfig test_dir "bar/app/Main.hs" hitBreakpointIn cfg "bar/src/Bar.hs" 8 -otherHomeUnitBP2 :: Assertion +otherHomeUnitBP2 :: String -> Assertion otherHomeUnitBP2 = withCommonSetup $ \test_dir -> do let cfg = mkLaunchConfig test_dir "bar/app/Main.hs" hitBreakpointIn cfg "foo/src/Foo.hs" 6 diff --git a/test/haskell/Test/Utils.hs b/test/haskell/Test/Utils.hs index 05556c1c..c197ab5c 100644 --- a/test/haskell/Test/Utils.hs +++ b/test/haskell/Test/Utils.hs @@ -2,7 +2,7 @@ module Test.Utils where import Control.Monad (when) import Data.List (isInfixOf) -import System.Directory (doesFileExist) +import System.Directory (doesFileExist,doesDirectoryExist) import System.FilePath import System.IO.Temp import qualified System.Process as P @@ -14,7 +14,7 @@ withHermeticDir :: Bool -- ^ Whether to keep the temp dir around f -> (FilePath -> IO r) -- ^ Continuation receives hermetic test dir (in temporary dir) -> IO r withHermeticDir keep src k = do - withTmpDir "hdb-test" $ \dest -> do + withTestTmpDir keep $ \dest -> do P.callCommand $ "cp -r " ++ src ++ " " ++ dest let destTestDir = dest takeBaseName src -- Some test projects reference @./haskell-debugger-view@ in their @@ -24,14 +24,6 @@ withHermeticDir keep src k = do cpHaskellDebuggerViewIfNeeded destTestDir k destTestDir where - withTmpDir | keep = withPersistentSystemTempDirectory - | otherwise = withSystemTempDirectory - - withPersistentSystemTempDirectory :: String -> (FilePath -> IO r) -> IO r - withPersistentSystemTempDirectory template k' = do - dir <- flip createTempDirectory template =<< getCanonicalTemporaryDirectory - k' dir - cpHaskellDebuggerViewIfNeeded testDir = do let cabalProject = testDir "cabal.project" existsCP <- doesFileExist cabalProject @@ -41,3 +33,37 @@ withHermeticDir keep src k = do P.callCommand $ "cp -r haskell-debugger-view " ++ testDir "haskell-debugger-view" + +withTestTmpDir :: Bool -- ^ Whether to keep the temp dir around for inspection + -> (FilePath -> IO r) -- ^ Continuation receives temporary dir + -> IO r +withTestTmpDir keep k = do + withTmpDir "hdb-test" k + where + withTmpDir | keep = withPersistentSystemTempDirectory + | otherwise = withSystemTempDirectory + + withPersistentSystemTempDirectory :: String -> (FilePath -> IO r) -> IO r + withPersistentSystemTempDirectory template k' = do + dir <- flip createTempDirectory template =<< getCanonicalTemporaryDirectory + k' dir + + +withTmpDirFromRepo :: Bool -- ^ Whether to keep the temp dir around for inspection + -> FilePath -- ^ Test dir + -> (FilePath -> IO r) -- ^ Continuation receives temporary dir + -> IO r +withTmpDirFromRepo keep src k = do + b <- doesDirectoryExist $ src ".git" + withTestTmpDir keep $ \ dest -> do + case b of + False -> do + P.callCommand $ "cp -r " ++ src ++ "/. " ++ dest + True -> do + P.callCommand $ unwords + [ "git ls-files -z --full-name --" + , src + , "| cpio -0 -pdm " + , dest + ] + k dest \ No newline at end of file diff --git a/test/integration/T107a/hie.yaml b/test/integration/T107a/hie.yaml index b8e05648..d2595193 100644 --- a/test/integration/T107a/hie.yaml +++ b/test/integration/T107a/hie.yaml @@ -1,3 +1,3 @@ cradle: cabal: - components: "exe:t3" \ No newline at end of file + component: "exe:t3" \ No newline at end of file diff --git a/test/integration/T38/bar/app/Main.hs b/test/integration/T38/bar/app/Main.hs new file mode 100644 index 00000000..c810cab8 --- /dev/null +++ b/test/integration/T38/bar/app/Main.hs @@ -0,0 +1,9 @@ +module Main where + +import Bar +import Foo + +main :: IO () +main = do + myFibonacciTest + print (fib 5) diff --git a/test/integration/T38/bar/bar.cabal b/test/integration/T38/bar/bar.cabal new file mode 100644 index 00000000..f8bd7a33 --- /dev/null +++ b/test/integration/T38/bar/bar.cabal @@ -0,0 +1,20 @@ +cabal-version: 3.8 +name: bar +version: 0.1.0.0 +build-type: Simple + +library + exposed-modules: Bar + build-depends: + base, + foo, + hs-source-dirs: src + default-language: Haskell2010 + +executable bar-exe + main-is: app/Main.hs + build-depends: + base, + bar, + foo, + default-language: Haskell2010 diff --git a/test/integration/T38/bar/src/Bar.hs b/test/integration/T38/bar/src/Bar.hs new file mode 100644 index 00000000..0341b0ba --- /dev/null +++ b/test/integration/T38/bar/src/Bar.hs @@ -0,0 +1,10 @@ +module Bar where + +import Foo + +myFibonacciTest :: IO () +myFibonacciTest = do + print (fib 1) + print (fib 4) + print (fib 8) + print (fib 10) diff --git a/test/integration/T38/cabal.project b/test/integration/T38/cabal.project new file mode 100644 index 00000000..16ebaec9 --- /dev/null +++ b/test/integration/T38/cabal.project @@ -0,0 +1,3 @@ +packages: + ./foo + ./bar diff --git a/test/integration/T38/foo/foo.cabal b/test/integration/T38/foo/foo.cabal new file mode 100644 index 00000000..699b5478 --- /dev/null +++ b/test/integration/T38/foo/foo.cabal @@ -0,0 +1,10 @@ +cabal-version: 3.8 +name: foo +version: 0.1.0.0 +build-type: Simple + +library + exposed-modules: Foo + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 diff --git a/test/integration/T38/foo/src/Foo.hs b/test/integration/T38/foo/src/Foo.hs new file mode 100644 index 00000000..c1355ad6 --- /dev/null +++ b/test/integration/T38/foo/src/Foo.hs @@ -0,0 +1,6 @@ +module Foo where + +fib :: Int -> Int +fib n + | n <= 1 = 1 + | otherwise = fib (n - 1) + fib (n - 2)