From 6297e11e84f609c08384a83f9bd1e61d51de740a Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Fri, 29 May 2020 19:58:34 -0700 Subject: Impelement test/executable specific dependencies - with the possibility of them being "circular", meaning if one of them depends on the current library, it will still work --- circular_example/.gitignore | 1 + circular_example/fpm.toml | 8 ++ circular_example/src/greet_m.f90 | 13 +++ circular_example/tests/main.f90 | 7 ++ circular_test/.gitignore | 1 + circular_test/fpm.toml | 4 + circular_test/src/hello_test.f90 | 12 +++ src/Build.hs | 7 +- src/Fpm.hs | 185 ++++++++++++++++++++++++++------------- test/Spec.hs | 5 ++ 10 files changed, 178 insertions(+), 65 deletions(-) create mode 100644 circular_example/.gitignore create mode 100644 circular_example/fpm.toml create mode 100644 circular_example/src/greet_m.f90 create mode 100644 circular_example/tests/main.f90 create mode 100644 circular_test/.gitignore create mode 100644 circular_test/fpm.toml create mode 100644 circular_test/src/hello_test.f90 diff --git a/circular_example/.gitignore b/circular_example/.gitignore new file mode 100644 index 0000000..a007fea --- /dev/null +++ b/circular_example/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/circular_example/fpm.toml b/circular_example/fpm.toml new file mode 100644 index 0000000..034ec57 --- /dev/null +++ b/circular_example/fpm.toml @@ -0,0 +1,8 @@ +name = "circular_example" + +[[test]] + name = "test" + source-dir = "tests" + main = "main.f90" + [test.dependencies] + circular_test = { path = "../circular_test" } diff --git a/circular_example/src/greet_m.f90 b/circular_example/src/greet_m.f90 new file mode 100644 index 0000000..2372f9a --- /dev/null +++ b/circular_example/src/greet_m.f90 @@ -0,0 +1,13 @@ +module greet_m + implicit none + private + + public :: make_greeting +contains + function make_greeting(name) result(greeting) + character(len=*), intent(in) :: name + character(len=:), allocatable :: greeting + + greeting = "Hello, " // name // "!" + end function make_greeting +end module greet_m diff --git a/circular_example/tests/main.f90 b/circular_example/tests/main.f90 new file mode 100644 index 0000000..5b7d803 --- /dev/null +++ b/circular_example/tests/main.f90 @@ -0,0 +1,7 @@ +program run_tests + use hello_test, only: run_test + + implicit none + + call run_test +end program run_tests diff --git a/circular_test/.gitignore b/circular_test/.gitignore new file mode 100644 index 0000000..a007fea --- /dev/null +++ b/circular_test/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/circular_test/fpm.toml b/circular_test/fpm.toml new file mode 100644 index 0000000..56cfa2e --- /dev/null +++ b/circular_test/fpm.toml @@ -0,0 +1,4 @@ +name = "circular_test" + +[dependencies] +circular_example = { path = "../circular_example"} diff --git a/circular_test/src/hello_test.f90 b/circular_test/src/hello_test.f90 new file mode 100644 index 0000000..5a591c6 --- /dev/null +++ b/circular_test/src/hello_test.f90 @@ -0,0 +1,12 @@ +module hello_test + use greet_m, only: make_greeting + + implicit none + private + + public :: run_test +contains + subroutine run_test + print *, make_greeting("from test") + end subroutine run_test +end module hello_test diff --git a/src/Build.hs b/src/Build.hs index 2e471ec..913e754 100644 --- a/src/Build.hs +++ b/src/Build.hs @@ -69,8 +69,9 @@ buildProgram -> [String] -> String -> FilePath + -> [FilePath] -> IO () -buildProgram programDirectory libraryDirectories sourceExtensions buildDirectory compiler flags programName programSource +buildProgram programDirectory libraryDirectories sourceExtensions buildDirectory compiler flags programName programSource archives = do sourceFiles <- getDirectoriesFiles [programDirectory] sourceExtensions canonicalProgramSource <- makeAbsolute $ programDirectory programSource @@ -93,7 +94,6 @@ buildProgram programDirectory libraryDirectories sourceExtensions buildDirectory let allModuleMaps = moduleLookupMap `Map.union` foldl Map.union Map.empty otherModuleMaps let includeFlags = map ("-I" ++) libraryDirectories - archives <- getDirectoriesFiles libraryDirectories [".a"] shake shakeOptions { shakeFiles = buildDirectory , shakeChange = ChangeModtimeAndDigest , shakeColor = True @@ -151,7 +151,7 @@ buildLibrary -> [String] -> String -> [FilePath] - -> IO () + -> IO (FilePath) buildLibrary libraryDirectory sourceExtensions buildDirectory compiler flags libraryName otherLibraryDirectories = do sourceFiles <- getDirectoriesFiles [libraryDirectory] sourceExtensions @@ -193,6 +193,7 @@ buildLibrary libraryDirectory sourceExtensions buildDirectory compiler flags lib need objectFiles cmd "ar" ["rs"] a objectFiles want [archiveFile] + return archiveFile -- A little wrapper around getDirectoryFiles so we can get files from multiple directories getDirectoriesFiles :: [FilePath] -> [FilePattern] -> IO [FilePath] diff --git a/src/Fpm.hs b/src/Fpm.hs index 253bc85..8e6a205 100644 --- a/src/Fpm.hs +++ b/src/Fpm.hs @@ -79,15 +79,16 @@ data Executable = Executable { executableSourceDir :: String , executableMainFile :: String , executableName :: String -} + , executableDependencies :: (Map.Map String Version) +} deriving Show -data Version = SimpleVersion String | GitVersion GitVersionSpec | PathVersion PathVersionSpec +data Version = SimpleVersion String | GitVersion GitVersionSpec | PathVersion PathVersionSpec deriving Show -data GitVersionSpec = GitVersionSpec { gitVersionSpecUrl :: String, gitVersionSpecRef :: Maybe GitRef } +data GitVersionSpec = GitVersionSpec { gitVersionSpecUrl :: String, gitVersionSpecRef :: Maybe GitRef } deriving Show -data GitRef = Tag String | Branch String | Commit String +data GitRef = Tag String | Branch String | Commit String deriving Show -data PathVersionSpec = PathVersionSpec { pathVersionSpecPath :: String } +data PathVersionSpec = PathVersionSpec { pathVersionSpecPath :: String } deriving Show data Command = Run | Test | Build @@ -150,46 +151,67 @@ build settings = do let flags = appSettingsFlags settings let executables = appSettingsExecutables settings let tests = appSettingsTests settings - builtDependencies <- - fetchDependencies [projectName] (appSettingsDependencies settings) - >>= buildDependencies buildPrefix compiler flags - executableDepends <- case appSettingsLibrary settings of + mainDependencyTrees <- fetchDependencies (appSettingsDependencies settings) + builtDependencies <- buildDependencies buildPrefix + compiler + flags + mainDependencyTrees + (executableDepends, maybeTree) <- case appSettingsLibrary settings of Just librarySettings -> do let librarySourceDir' = librarySourceDir librarySettings - buildLibrary librarySourceDir' - [".f90", ".f", ".F", ".F90", ".f95", ".f03"] - (buildPrefix projectName) - compiler - flags - projectName - builtDependencies - return $ (buildPrefix projectName) : builtDependencies + let thisDependencyTree = Dependency + { dependencyName = projectName + , dependencyPath = "." + , dependencySourcePath = librarySourceDir' + , dependencyDependencies = mainDependencyTrees + } + thisArchive <- buildLibrary librarySourceDir' + [".f90", ".f", ".F", ".F90", ".f95", ".f03"] + (buildPrefix projectName) + compiler + flags + projectName + (map fst builtDependencies) + return + $ ( (buildPrefix projectName, thisArchive) : builtDependencies + , Just thisDependencyTree + ) Nothing -> do - return builtDependencies + return (builtDependencies, Nothing) mapM_ - (\Executable { executableSourceDir = sourceDir, executableMainFile = mainFile, executableName = name } -> + (\Executable { executableSourceDir = sourceDir, executableMainFile = mainFile, executableName = name, executableDependencies = dependencies } -> do - buildProgram sourceDir - executableDepends - [".f90", ".f", ".F", ".F90", ".f95", ".f03"] - (buildPrefix sourceDir) - compiler - flags - name - mainFile + localDependencies <- + fetchExecutableDependencies maybeTree dependencies + >>= buildDependencies buildPrefix compiler flags + buildProgram + sourceDir + ((map fst executableDepends) ++ (map fst localDependencies)) + [".f90", ".f", ".F", ".F90", ".f95", ".f03"] + (buildPrefix sourceDir) + compiler + flags + name + mainFile + ((map snd executableDepends) ++ (map snd localDependencies)) ) executables mapM_ - (\Executable { executableSourceDir = sourceDir, executableMainFile = mainFile, executableName = name } -> + (\Executable { executableSourceDir = sourceDir, executableMainFile = mainFile, executableName = name, executableDependencies = dependencies } -> do - buildProgram sourceDir - executableDepends - [".f90", ".f", ".F", ".F90", ".f95", ".f03"] - (buildPrefix sourceDir) - compiler - flags - name - mainFile + localDependencies <- + fetchExecutableDependencies maybeTree dependencies + >>= buildDependencies buildPrefix compiler flags + buildProgram + sourceDir + ((map fst executableDepends) ++ (map fst localDependencies)) + [".f90", ".f", ".F", ".F90", ".f95", ".f03"] + (buildPrefix sourceDir) + compiler + flags + name + mainFile + ((map snd executableDepends) ++ (map snd localDependencies)) ) tests @@ -254,6 +276,8 @@ executableCodec = .= executableMainFile <*> Toml.string "name" .= executableName + <*> Toml.tableMap Toml._KeyString versionCodec "dependencies" + .= executableDependencies matchSimpleVersion :: Version -> Maybe String matchSimpleVersion = \case @@ -289,7 +313,9 @@ versionCodec :: Toml.Key -> Toml.TomlCodec Version versionCodec key = Toml.dimatch matchSimpleVersion SimpleVersion (Toml.string key) <|> Toml.dimatch matchGitVersion GitVersion (Toml.table gitVersionCodec key) - <|> Toml.dimatch matchPathVersion PathVersion (Toml.table pathVersionCodec key) + <|> Toml.dimatch matchPathVersion + PathVersion + (Toml.table pathVersionCodec key) gitVersionCodec :: Toml.TomlCodec GitVersionSpec gitVersionCodec = @@ -307,7 +333,7 @@ gitRefCodec = pathVersionCodec :: Toml.TomlCodec PathVersionSpec pathVersionCodec = - PathVersionSpec <$> Toml.string "path" .= pathVersionSpecPath + PathVersionSpec <$> Toml.string "path" .= pathVersionSpecPath toml2AppSettings :: TomlSettings -> Bool -> IO AppSettings toml2AppSettings tomlSettings release = do @@ -370,9 +396,10 @@ getExecutableSettings [] projectName = do defaultMainExists <- doesFileExist ("app" "main.f90") if defaultMainExists then return - [ Executable { executableSourceDir = "app" - , executableMainFile = "main.f90" - , executableName = projectName + [ Executable { executableSourceDir = "app" + , executableMainFile = "main.f90" + , executableName = projectName + , executableDependencies = Map.empty } ] else return [] @@ -387,9 +414,10 @@ getTestSettings [] = do defaultMainExists <- doesFileExist ("test" "main.f90") if defaultMainExists then return - [ Executable { executableSourceDir = "test" - , executableMainFile = "main.f90" - , executableName = "runTests" + [ Executable { executableSourceDir = "test" + , executableMainFile = "main.f90" + , executableName = "runTests" + , executableDependencies = Map.empty } ] else return [] @@ -410,13 +438,9 @@ makeBuildPrefix compiler release = dealing with half fetched, or adding dependencies. TODO check for version compatibility issues -} -fetchDependencies :: [String] -> Map.Map String Version -> IO [DependencyTree] -fetchDependencies knownPackages dependencies = do - theseDependencies <- mapM - (uncurry fetchDependency) - (filter (\(name, _) -> not (name `elem` knownPackages)) - (Map.toList dependencies) - ) +fetchDependencies :: Map.Map String Version -> IO [DependencyTree] +fetchDependencies dependencies = do + theseDependencies <- mapM (uncurry fetchDependency) (Map.toList dependencies) mapM fetchTransitiveDependencies theseDependencies where fetchTransitiveDependencies :: (String, FilePath) -> IO DependencyTree @@ -427,7 +451,40 @@ fetchDependencies knownPackages dependencies = do case librarySettingsM of Just librarySettings -> do newDependencies <- fetchDependencies - (name : knownPackages) + (tomlSettingsDependencies tomlSettings) + return $ Dependency + { dependencyName = name + , dependencyPath = path + , dependencySourcePath = path (librarySourceDir librarySettings) + , dependencyDependencies = newDependencies + } + Nothing -> do + putStrLn $ "No library found in " ++ name + undefined + +fetchExecutableDependencies + :: (Maybe DependencyTree) -> Map.Map String Version -> IO [DependencyTree] +fetchExecutableDependencies maybeProjectTree dependencies = + case maybeProjectTree of + Just projectTree@(Dependency name _ _ _) -> + if name `Map.member` dependencies {- map contains this project-} + then fmap (projectTree :) + (fetchDependencies (Map.delete name dependencies)) {- fetch the other dependencies and include the project tree in the result -} + else do {- fetch all the dependencies, passing the project tree on down -} + theseDependencies <- mapM (uncurry fetchDependency) + (Map.toList dependencies) + mapM fetchTransitiveDependencies theseDependencies + Nothing -> fetchDependencies dependencies + where + fetchTransitiveDependencies :: (String, FilePath) -> IO DependencyTree + fetchTransitiveDependencies (name, path) = do + tomlSettings <- Toml.decodeFile settingsCodec (path "fpm.toml") + librarySettingsM <- withCurrentDirectory path + $ getLibrarySettings (tomlSettingsLibrary tomlSettings) + case librarySettingsM of + Just librarySettings -> do + newDependencies <- fetchExecutableDependencies + maybeProjectTree (tomlSettingsDependencies tomlSettings) return $ Dependency { dependencyName = name @@ -471,13 +528,17 @@ fetchDependency name version = do the transitive dependencies have been built before trying to build this one -} buildDependencies - :: String -> String -> [String] -> [DependencyTree] -> IO [FilePath] + :: String + -> String + -> [String] + -> [DependencyTree] + -> IO [(FilePath, FilePath)] buildDependencies buildPrefix compiler flags dependencies = do built <- concatMapM (buildDependency buildPrefix compiler flags) dependencies return $ nub built buildDependency - :: String -> String -> [String] -> DependencyTree -> IO [FilePath] + :: String -> String -> [String] -> DependencyTree -> IO [(FilePath, FilePath)] buildDependency buildPrefix compiler flags (Dependency name path sourcePath dependencies) = do transitiveDependencies <- buildDependencies buildPrefix @@ -485,11 +546,11 @@ buildDependency buildPrefix compiler flags (Dependency name path sourcePath depe flags dependencies let buildPath = buildPrefix name - buildLibrary sourcePath - [".f90", ".f", ".F", ".F90", ".f95", ".f03"] - buildPath - compiler - flags - name - transitiveDependencies - return $ buildPath : transitiveDependencies + thisArchive <- buildLibrary sourcePath + [".f90", ".f", ".F", ".F90", ".f95", ".f03"] + buildPath + compiler + flags + name + (map fst transitiveDependencies) + return $ (buildPath, thisArchive) : transitiveDependencies diff --git a/test/Spec.hs b/test/Spec.hs index dfa70d6..2808af9 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -10,6 +10,7 @@ main = do testHelloWorld testHelloComplex testHelloFpm + testCircular testHelloWorld :: IO () testHelloWorld = @@ -22,3 +23,7 @@ testHelloComplex = testHelloFpm :: IO () testHelloFpm = withCurrentDirectory "hello_fpm" $ start $ Arguments Run False + +testCircular :: IO () +testCircular = + withCurrentDirectory "circular_example" $ start $ Arguments Test False -- cgit v1.2.3 From 9d83f04a6f6318fd51405da500a3529fe7f9fabd Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sat, 30 May 2020 16:22:02 -0700 Subject: Run executables or tests synchronously --- src/Fpm.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Fpm.hs b/src/Fpm.hs index 8e6a205..417b6ed 100644 --- a/src/Fpm.hs +++ b/src/Fpm.hs @@ -126,7 +126,7 @@ app args settings = case command' args of canonicalExecutables <- mapM makeAbsolute executables case canonicalExecutables of [] -> putStrLn "No Executables Found" - _ -> mapM_ runCommand canonicalExecutables + _ -> mapM_ system canonicalExecutables Test -> do build settings let buildPrefix = appSettingsBuildPrefix settings @@ -141,7 +141,7 @@ app args settings = case command' args of canonicalExecutables <- mapM makeAbsolute executables case canonicalExecutables of [] -> putStrLn "No Tests Found" - _ -> mapM_ runCommand canonicalExecutables + _ -> mapM_ system canonicalExecutables build :: AppSettings -> IO () build settings = do -- cgit v1.2.3 From f33bb50d3e15035aee97ef2a9c032f511aab447f Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sat, 30 May 2020 17:13:09 -0700 Subject: Move example packages into test folder --- circular_example/.gitignore | 1 - circular_example/fpm.toml | 8 -------- circular_example/src/greet_m.f90 | 13 ------------ circular_example/tests/main.f90 | 7 ------- circular_test/.gitignore | 1 - circular_test/fpm.toml | 4 ---- circular_test/src/hello_test.f90 | 12 ----------- hello_complex/.gitignore | 1 - hello_complex/apps/say_goodbye/say_goodbye.f90 | 7 ------- hello_complex/apps/say_hello/say_hello.f90 | 7 ------- hello_complex/fpm.toml | 24 ---------------------- hello_complex/source/farewell_m.f90 | 13 ------------ hello_complex/source/greet_m.f90 | 13 ------------ hello_complex/tests/farewell/farewell_test.f90 | 18 ---------------- hello_complex/tests/greet/greet_test.f90 | 18 ---------------- hello_fpm/.gitignore | 1 - hello_fpm/app/main.f90 | 9 -------- hello_fpm/fpm.toml | 4 ---- hello_world/.gitignore | 1 - hello_world/app/main.f90 | 3 --- hello_world/fpm.toml | 1 - test/Spec.hs | 10 +++++---- test/example_packages/circular_example/.gitignore | 1 + test/example_packages/circular_example/fpm.toml | 8 ++++++++ .../circular_example/src/greet_m.f90 | 13 ++++++++++++ .../circular_example/tests/main.f90 | 7 +++++++ test/example_packages/circular_test/.gitignore | 1 + test/example_packages/circular_test/fpm.toml | 4 ++++ .../circular_test/src/hello_test.f90 | 12 +++++++++++ test/example_packages/hello_complex/.gitignore | 1 + .../hello_complex/apps/say_goodbye/say_goodbye.f90 | 7 +++++++ .../hello_complex/apps/say_hello/say_hello.f90 | 7 +++++++ test/example_packages/hello_complex/fpm.toml | 24 ++++++++++++++++++++++ .../hello_complex/source/farewell_m.f90 | 13 ++++++++++++ .../hello_complex/source/greet_m.f90 | 13 ++++++++++++ .../hello_complex/tests/farewell/farewell_test.f90 | 18 ++++++++++++++++ .../hello_complex/tests/greet/greet_test.f90 | 18 ++++++++++++++++ test/example_packages/hello_fpm/.gitignore | 1 + test/example_packages/hello_fpm/app/main.f90 | 9 ++++++++ test/example_packages/hello_fpm/fpm.toml | 4 ++++ test/example_packages/hello_world/.gitignore | 1 + test/example_packages/hello_world/app/main.f90 | 3 +++ test/example_packages/hello_world/fpm.toml | 1 + 43 files changed, 172 insertions(+), 170 deletions(-) delete mode 100644 circular_example/.gitignore delete mode 100644 circular_example/fpm.toml delete mode 100644 circular_example/src/greet_m.f90 delete mode 100644 circular_example/tests/main.f90 delete mode 100644 circular_test/.gitignore delete mode 100644 circular_test/fpm.toml delete mode 100644 circular_test/src/hello_test.f90 delete mode 100644 hello_complex/.gitignore delete mode 100644 hello_complex/apps/say_goodbye/say_goodbye.f90 delete mode 100644 hello_complex/apps/say_hello/say_hello.f90 delete mode 100644 hello_complex/fpm.toml delete mode 100644 hello_complex/source/farewell_m.f90 delete mode 100644 hello_complex/source/greet_m.f90 delete mode 100644 hello_complex/tests/farewell/farewell_test.f90 delete mode 100644 hello_complex/tests/greet/greet_test.f90 delete mode 100644 hello_fpm/.gitignore delete mode 100644 hello_fpm/app/main.f90 delete mode 100644 hello_fpm/fpm.toml delete mode 100644 hello_world/.gitignore delete mode 100644 hello_world/app/main.f90 delete mode 100644 hello_world/fpm.toml create mode 100644 test/example_packages/circular_example/.gitignore create mode 100644 test/example_packages/circular_example/fpm.toml create mode 100644 test/example_packages/circular_example/src/greet_m.f90 create mode 100644 test/example_packages/circular_example/tests/main.f90 create mode 100644 test/example_packages/circular_test/.gitignore create mode 100644 test/example_packages/circular_test/fpm.toml create mode 100644 test/example_packages/circular_test/src/hello_test.f90 create mode 100644 test/example_packages/hello_complex/.gitignore create mode 100644 test/example_packages/hello_complex/apps/say_goodbye/say_goodbye.f90 create mode 100644 test/example_packages/hello_complex/apps/say_hello/say_hello.f90 create mode 100644 test/example_packages/hello_complex/fpm.toml create mode 100644 test/example_packages/hello_complex/source/farewell_m.f90 create mode 100644 test/example_packages/hello_complex/source/greet_m.f90 create mode 100644 test/example_packages/hello_complex/tests/farewell/farewell_test.f90 create mode 100644 test/example_packages/hello_complex/tests/greet/greet_test.f90 create mode 100644 test/example_packages/hello_fpm/.gitignore create mode 100644 test/example_packages/hello_fpm/app/main.f90 create mode 100644 test/example_packages/hello_fpm/fpm.toml create mode 100644 test/example_packages/hello_world/.gitignore create mode 100644 test/example_packages/hello_world/app/main.f90 create mode 100644 test/example_packages/hello_world/fpm.toml diff --git a/circular_example/.gitignore b/circular_example/.gitignore deleted file mode 100644 index a007fea..0000000 --- a/circular_example/.gitignore +++ /dev/null @@ -1 +0,0 @@ -build/* diff --git a/circular_example/fpm.toml b/circular_example/fpm.toml deleted file mode 100644 index 034ec57..0000000 --- a/circular_example/fpm.toml +++ /dev/null @@ -1,8 +0,0 @@ -name = "circular_example" - -[[test]] - name = "test" - source-dir = "tests" - main = "main.f90" - [test.dependencies] - circular_test = { path = "../circular_test" } diff --git a/circular_example/src/greet_m.f90 b/circular_example/src/greet_m.f90 deleted file mode 100644 index 2372f9a..0000000 --- a/circular_example/src/greet_m.f90 +++ /dev/null @@ -1,13 +0,0 @@ -module greet_m - implicit none - private - - public :: make_greeting -contains - function make_greeting(name) result(greeting) - character(len=*), intent(in) :: name - character(len=:), allocatable :: greeting - - greeting = "Hello, " // name // "!" - end function make_greeting -end module greet_m diff --git a/circular_example/tests/main.f90 b/circular_example/tests/main.f90 deleted file mode 100644 index 5b7d803..0000000 --- a/circular_example/tests/main.f90 +++ /dev/null @@ -1,7 +0,0 @@ -program run_tests - use hello_test, only: run_test - - implicit none - - call run_test -end program run_tests diff --git a/circular_test/.gitignore b/circular_test/.gitignore deleted file mode 100644 index a007fea..0000000 --- a/circular_test/.gitignore +++ /dev/null @@ -1 +0,0 @@ -build/* diff --git a/circular_test/fpm.toml b/circular_test/fpm.toml deleted file mode 100644 index 56cfa2e..0000000 --- a/circular_test/fpm.toml +++ /dev/null @@ -1,4 +0,0 @@ -name = "circular_test" - -[dependencies] -circular_example = { path = "../circular_example"} diff --git a/circular_test/src/hello_test.f90 b/circular_test/src/hello_test.f90 deleted file mode 100644 index 5a591c6..0000000 --- a/circular_test/src/hello_test.f90 +++ /dev/null @@ -1,12 +0,0 @@ -module hello_test - use greet_m, only: make_greeting - - implicit none - private - - public :: run_test -contains - subroutine run_test - print *, make_greeting("from test") - end subroutine run_test -end module hello_test diff --git a/hello_complex/.gitignore b/hello_complex/.gitignore deleted file mode 100644 index a007fea..0000000 --- a/hello_complex/.gitignore +++ /dev/null @@ -1 +0,0 @@ -build/* diff --git a/hello_complex/apps/say_goodbye/say_goodbye.f90 b/hello_complex/apps/say_goodbye/say_goodbye.f90 deleted file mode 100644 index 6966e79..0000000 --- a/hello_complex/apps/say_goodbye/say_goodbye.f90 +++ /dev/null @@ -1,7 +0,0 @@ -program say_goodbye - use farewell_m, only: make_farewell - - implicit none - - print *, make_farewell("World") -end program say_goodbye diff --git a/hello_complex/apps/say_hello/say_hello.f90 b/hello_complex/apps/say_hello/say_hello.f90 deleted file mode 100644 index cc648f2..0000000 --- a/hello_complex/apps/say_hello/say_hello.f90 +++ /dev/null @@ -1,7 +0,0 @@ -program say_hello - use greet_m, only: make_greeting - - implicit none - - print *, make_greeting("World") -end program say_hello diff --git a/hello_complex/fpm.toml b/hello_complex/fpm.toml deleted file mode 100644 index d185745..0000000 --- a/hello_complex/fpm.toml +++ /dev/null @@ -1,24 +0,0 @@ -name = "hello_complex" - -[library] -source-dir="source" - -[[executable]] -name="say_hello" -source-dir="apps/say_hello" -main="say_hello.f90" - -[[executable]] -name="say_goodbye" -source-dir="apps/say_goodbye" -main="say_goodbye.f90" - -[[test]] -name="greet_test" -source-dir="tests/greet" -main="greet_test.f90" - -[[test]] -name="farewell_test" -source-dir="tests/farewell" -main="farewell_test.f90" diff --git a/hello_complex/source/farewell_m.f90 b/hello_complex/source/farewell_m.f90 deleted file mode 100644 index 9fc75b9..0000000 --- a/hello_complex/source/farewell_m.f90 +++ /dev/null @@ -1,13 +0,0 @@ -module farewell_m - implicit none - private - - public :: make_farewell -contains - function make_farewell(name) result(greeting) - character(len=*), intent(in) :: name - character(len=:), allocatable :: greeting - - greeting = "Goodbye, " // name // "!" - end function make_farewell -end module farewell_m diff --git a/hello_complex/source/greet_m.f90 b/hello_complex/source/greet_m.f90 deleted file mode 100644 index 2372f9a..0000000 --- a/hello_complex/source/greet_m.f90 +++ /dev/null @@ -1,13 +0,0 @@ -module greet_m - implicit none - private - - public :: make_greeting -contains - function make_greeting(name) result(greeting) - character(len=*), intent(in) :: name - character(len=:), allocatable :: greeting - - greeting = "Hello, " // name // "!" - end function make_greeting -end module greet_m diff --git a/hello_complex/tests/farewell/farewell_test.f90 b/hello_complex/tests/farewell/farewell_test.f90 deleted file mode 100644 index 0f21b18..0000000 --- a/hello_complex/tests/farewell/farewell_test.f90 +++ /dev/null @@ -1,18 +0,0 @@ -program farewell_test - use farewell_m, only: make_farewell - use iso_fortran_env, only: error_unit, output_unit - - implicit none - - character(len=:), allocatable :: farewell - - allocate(character(len=0) :: farewell) - farewell = make_farewell("World") - - if (farewell == "Goodbye, World!") then - write(output_unit, *) "Passed" - else - write(error_unit, *) "Failed" - call exit(1) - end if -end program farewell_test diff --git a/hello_complex/tests/greet/greet_test.f90 b/hello_complex/tests/greet/greet_test.f90 deleted file mode 100644 index 41fa508..0000000 --- a/hello_complex/tests/greet/greet_test.f90 +++ /dev/null @@ -1,18 +0,0 @@ -program greet_test - use greet_m, only: make_greeting - use iso_fortran_env, only: error_unit, output_unit - - implicit none - - character(len=:), allocatable :: greeting - - allocate(character(len=0) :: greeting) - greeting = make_greeting("World") - - if (greeting == "Hello, World!") then - write(output_unit, *) "Passed" - else - write(error_unit, *) "Failed" - call exit(1) - end if -end program greet_test diff --git a/hello_fpm/.gitignore b/hello_fpm/.gitignore deleted file mode 100644 index a007fea..0000000 --- a/hello_fpm/.gitignore +++ /dev/null @@ -1 +0,0 @@ -build/* diff --git a/hello_fpm/app/main.f90 b/hello_fpm/app/main.f90 deleted file mode 100644 index 5df6d64..0000000 --- a/hello_fpm/app/main.f90 +++ /dev/null @@ -1,9 +0,0 @@ -program hello_fpm - use farewell_m, only: make_farewell - use greet_m, only: make_greeting - - implicit none - - print *, make_greeting("fpm") - print *, make_farewell("fpm") -end program hello_fpm diff --git a/hello_fpm/fpm.toml b/hello_fpm/fpm.toml deleted file mode 100644 index d94d904..0000000 --- a/hello_fpm/fpm.toml +++ /dev/null @@ -1,4 +0,0 @@ -name = "hello_fpm" - -[dependencies] -hello_complex = { path = "../hello_complex" } diff --git a/hello_world/.gitignore b/hello_world/.gitignore deleted file mode 100644 index a007fea..0000000 --- a/hello_world/.gitignore +++ /dev/null @@ -1 +0,0 @@ -build/* diff --git a/hello_world/app/main.f90 b/hello_world/app/main.f90 deleted file mode 100644 index d16022b..0000000 --- a/hello_world/app/main.f90 +++ /dev/null @@ -1,3 +0,0 @@ -program hello_world - print *, "Hello, World!" -end program hello_world diff --git a/hello_world/fpm.toml b/hello_world/fpm.toml deleted file mode 100644 index b80e8d1..0000000 --- a/hello_world/fpm.toml +++ /dev/null @@ -1 +0,0 @@ -name = "hello_world" diff --git a/test/Spec.hs b/test/Spec.hs index 2808af9..604d8af 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -5,6 +5,8 @@ import Fpm ( Arguments(..) ) import System.Directory ( withCurrentDirectory ) +example_path = "test" "example_packages" + main :: IO () main = do testHelloWorld @@ -14,16 +16,16 @@ main = do testHelloWorld :: IO () testHelloWorld = - withCurrentDirectory "hello_world" $ start $ Arguments Run False + withCurrentDirectory (example_path "hello_world") $ start $ Arguments Run False testHelloComplex :: IO () testHelloComplex = - withCurrentDirectory "hello_complex" $ start $ Arguments Test False + withCurrentDirectory (example_path "hello_complex") $ start $ Arguments Test False testHelloFpm :: IO () testHelloFpm = - withCurrentDirectory "hello_fpm" $ start $ Arguments Run False + withCurrentDirectory (example_path "hello_fpm") $ start $ Arguments Run False testCircular :: IO () testCircular = - withCurrentDirectory "circular_example" $ start $ Arguments Test False + withCurrentDirectory (example_path "circular_example") $ start $ Arguments Test False diff --git a/test/example_packages/circular_example/.gitignore b/test/example_packages/circular_example/.gitignore new file mode 100644 index 0000000..a007fea --- /dev/null +++ b/test/example_packages/circular_example/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/test/example_packages/circular_example/fpm.toml b/test/example_packages/circular_example/fpm.toml new file mode 100644 index 0000000..034ec57 --- /dev/null +++ b/test/example_packages/circular_example/fpm.toml @@ -0,0 +1,8 @@ +name = "circular_example" + +[[test]] + name = "test" + source-dir = "tests" + main = "main.f90" + [test.dependencies] + circular_test = { path = "../circular_test" } diff --git a/test/example_packages/circular_example/src/greet_m.f90 b/test/example_packages/circular_example/src/greet_m.f90 new file mode 100644 index 0000000..2372f9a --- /dev/null +++ b/test/example_packages/circular_example/src/greet_m.f90 @@ -0,0 +1,13 @@ +module greet_m + implicit none + private + + public :: make_greeting +contains + function make_greeting(name) result(greeting) + character(len=*), intent(in) :: name + character(len=:), allocatable :: greeting + + greeting = "Hello, " // name // "!" + end function make_greeting +end module greet_m diff --git a/test/example_packages/circular_example/tests/main.f90 b/test/example_packages/circular_example/tests/main.f90 new file mode 100644 index 0000000..5b7d803 --- /dev/null +++ b/test/example_packages/circular_example/tests/main.f90 @@ -0,0 +1,7 @@ +program run_tests + use hello_test, only: run_test + + implicit none + + call run_test +end program run_tests diff --git a/test/example_packages/circular_test/.gitignore b/test/example_packages/circular_test/.gitignore new file mode 100644 index 0000000..a007fea --- /dev/null +++ b/test/example_packages/circular_test/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/test/example_packages/circular_test/fpm.toml b/test/example_packages/circular_test/fpm.toml new file mode 100644 index 0000000..56cfa2e --- /dev/null +++ b/test/example_packages/circular_test/fpm.toml @@ -0,0 +1,4 @@ +name = "circular_test" + +[dependencies] +circular_example = { path = "../circular_example"} diff --git a/test/example_packages/circular_test/src/hello_test.f90 b/test/example_packages/circular_test/src/hello_test.f90 new file mode 100644 index 0000000..5a591c6 --- /dev/null +++ b/test/example_packages/circular_test/src/hello_test.f90 @@ -0,0 +1,12 @@ +module hello_test + use greet_m, only: make_greeting + + implicit none + private + + public :: run_test +contains + subroutine run_test + print *, make_greeting("from test") + end subroutine run_test +end module hello_test diff --git a/test/example_packages/hello_complex/.gitignore b/test/example_packages/hello_complex/.gitignore new file mode 100644 index 0000000..a007fea --- /dev/null +++ b/test/example_packages/hello_complex/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/test/example_packages/hello_complex/apps/say_goodbye/say_goodbye.f90 b/test/example_packages/hello_complex/apps/say_goodbye/say_goodbye.f90 new file mode 100644 index 0000000..6966e79 --- /dev/null +++ b/test/example_packages/hello_complex/apps/say_goodbye/say_goodbye.f90 @@ -0,0 +1,7 @@ +program say_goodbye + use farewell_m, only: make_farewell + + implicit none + + print *, make_farewell("World") +end program say_goodbye diff --git a/test/example_packages/hello_complex/apps/say_hello/say_hello.f90 b/test/example_packages/hello_complex/apps/say_hello/say_hello.f90 new file mode 100644 index 0000000..cc648f2 --- /dev/null +++ b/test/example_packages/hello_complex/apps/say_hello/say_hello.f90 @@ -0,0 +1,7 @@ +program say_hello + use greet_m, only: make_greeting + + implicit none + + print *, make_greeting("World") +end program say_hello diff --git a/test/example_packages/hello_complex/fpm.toml b/test/example_packages/hello_complex/fpm.toml new file mode 100644 index 0000000..d185745 --- /dev/null +++ b/test/example_packages/hello_complex/fpm.toml @@ -0,0 +1,24 @@ +name = "hello_complex" + +[library] +source-dir="source" + +[[executable]] +name="say_hello" +source-dir="apps/say_hello" +main="say_hello.f90" + +[[executable]] +name="say_goodbye" +source-dir="apps/say_goodbye" +main="say_goodbye.f90" + +[[test]] +name="greet_test" +source-dir="tests/greet" +main="greet_test.f90" + +[[test]] +name="farewell_test" +source-dir="tests/farewell" +main="farewell_test.f90" diff --git a/test/example_packages/hello_complex/source/farewell_m.f90 b/test/example_packages/hello_complex/source/farewell_m.f90 new file mode 100644 index 0000000..9fc75b9 --- /dev/null +++ b/test/example_packages/hello_complex/source/farewell_m.f90 @@ -0,0 +1,13 @@ +module farewell_m + implicit none + private + + public :: make_farewell +contains + function make_farewell(name) result(greeting) + character(len=*), intent(in) :: name + character(len=:), allocatable :: greeting + + greeting = "Goodbye, " // name // "!" + end function make_farewell +end module farewell_m diff --git a/test/example_packages/hello_complex/source/greet_m.f90 b/test/example_packages/hello_complex/source/greet_m.f90 new file mode 100644 index 0000000..2372f9a --- /dev/null +++ b/test/example_packages/hello_complex/source/greet_m.f90 @@ -0,0 +1,13 @@ +module greet_m + implicit none + private + + public :: make_greeting +contains + function make_greeting(name) result(greeting) + character(len=*), intent(in) :: name + character(len=:), allocatable :: greeting + + greeting = "Hello, " // name // "!" + end function make_greeting +end module greet_m diff --git a/test/example_packages/hello_complex/tests/farewell/farewell_test.f90 b/test/example_packages/hello_complex/tests/farewell/farewell_test.f90 new file mode 100644 index 0000000..0f21b18 --- /dev/null +++ b/test/example_packages/hello_complex/tests/farewell/farewell_test.f90 @@ -0,0 +1,18 @@ +program farewell_test + use farewell_m, only: make_farewell + use iso_fortran_env, only: error_unit, output_unit + + implicit none + + character(len=:), allocatable :: farewell + + allocate(character(len=0) :: farewell) + farewell = make_farewell("World") + + if (farewell == "Goodbye, World!") then + write(output_unit, *) "Passed" + else + write(error_unit, *) "Failed" + call exit(1) + end if +end program farewell_test diff --git a/test/example_packages/hello_complex/tests/greet/greet_test.f90 b/test/example_packages/hello_complex/tests/greet/greet_test.f90 new file mode 100644 index 0000000..41fa508 --- /dev/null +++ b/test/example_packages/hello_complex/tests/greet/greet_test.f90 @@ -0,0 +1,18 @@ +program greet_test + use greet_m, only: make_greeting + use iso_fortran_env, only: error_unit, output_unit + + implicit none + + character(len=:), allocatable :: greeting + + allocate(character(len=0) :: greeting) + greeting = make_greeting("World") + + if (greeting == "Hello, World!") then + write(output_unit, *) "Passed" + else + write(error_unit, *) "Failed" + call exit(1) + end if +end program greet_test diff --git a/test/example_packages/hello_fpm/.gitignore b/test/example_packages/hello_fpm/.gitignore new file mode 100644 index 0000000..a007fea --- /dev/null +++ b/test/example_packages/hello_fpm/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/test/example_packages/hello_fpm/app/main.f90 b/test/example_packages/hello_fpm/app/main.f90 new file mode 100644 index 0000000..5df6d64 --- /dev/null +++ b/test/example_packages/hello_fpm/app/main.f90 @@ -0,0 +1,9 @@ +program hello_fpm + use farewell_m, only: make_farewell + use greet_m, only: make_greeting + + implicit none + + print *, make_greeting("fpm") + print *, make_farewell("fpm") +end program hello_fpm diff --git a/test/example_packages/hello_fpm/fpm.toml b/test/example_packages/hello_fpm/fpm.toml new file mode 100644 index 0000000..d94d904 --- /dev/null +++ b/test/example_packages/hello_fpm/fpm.toml @@ -0,0 +1,4 @@ +name = "hello_fpm" + +[dependencies] +hello_complex = { path = "../hello_complex" } diff --git a/test/example_packages/hello_world/.gitignore b/test/example_packages/hello_world/.gitignore new file mode 100644 index 0000000..a007fea --- /dev/null +++ b/test/example_packages/hello_world/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/test/example_packages/hello_world/app/main.f90 b/test/example_packages/hello_world/app/main.f90 new file mode 100644 index 0000000..d16022b --- /dev/null +++ b/test/example_packages/hello_world/app/main.f90 @@ -0,0 +1,3 @@ +program hello_world + print *, "Hello, World!" +end program hello_world diff --git a/test/example_packages/hello_world/fpm.toml b/test/example_packages/hello_world/fpm.toml new file mode 100644 index 0000000..b80e8d1 --- /dev/null +++ b/test/example_packages/hello_world/fpm.toml @@ -0,0 +1 @@ +name = "hello_world" -- cgit v1.2.3 From 421fe3f5343079054ecb4cbe8298eb1ab2731c8d Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sun, 31 May 2020 19:58:20 -0700 Subject: Add dev-dependencies --- src/Fpm.hs | 10 ++++++++-- test/example_packages/circular_example/fpm.toml | 8 ++------ test/example_packages/circular_example/test/main.f90 | 7 +++++++ test/example_packages/circular_example/tests/main.f90 | 7 ------- 4 files changed, 17 insertions(+), 15 deletions(-) create mode 100644 test/example_packages/circular_example/test/main.f90 delete mode 100644 test/example_packages/circular_example/tests/main.f90 diff --git a/src/Fpm.hs b/src/Fpm.hs index 417b6ed..970f178 100644 --- a/src/Fpm.hs +++ b/src/Fpm.hs @@ -60,6 +60,7 @@ data TomlSettings = TomlSettings { , tomlSettingsExecutables :: [Executable] , tomlSettingsTests :: [Executable] , tomlSettingsDependencies :: (Map.Map String Version) + , tomlSettingsDevDependencies :: (Map.Map String Version) } data AppSettings = AppSettings { @@ -71,6 +72,7 @@ data AppSettings = AppSettings { , appSettingsExecutables :: [Executable] , appSettingsTests :: [Executable] , appSettingsDependencies :: (Map.Map String Version) + , appSettingsDevDependencies :: (Map.Map String Version) } data Library = Library { librarySourceDir :: String } @@ -196,6 +198,7 @@ build settings = do ((map snd executableDepends) ++ (map snd localDependencies)) ) executables + devDependencies <- fetchExecutableDependencies maybeTree (appSettingsDevDependencies settings) >>= buildDependencies buildPrefix compiler flags mapM_ (\Executable { executableSourceDir = sourceDir, executableMainFile = mainFile, executableName = name, executableDependencies = dependencies } -> do @@ -204,14 +207,14 @@ build settings = do >>= buildDependencies buildPrefix compiler flags buildProgram sourceDir - ((map fst executableDepends) ++ (map fst localDependencies)) + ((map fst executableDepends) ++ (map fst devDependencies) ++ (map fst localDependencies)) [".f90", ".f", ".F", ".F90", ".f95", ".f03"] (buildPrefix sourceDir) compiler flags name mainFile - ((map snd executableDepends) ++ (map snd localDependencies)) + ((map snd executableDepends) ++ (map snd devDependencies) ++ (map snd localDependencies)) ) tests @@ -263,6 +266,7 @@ settingsCodec = .= tomlSettingsTests <*> Toml.tableMap Toml._KeyString versionCodec "dependencies" .= tomlSettingsDependencies + <*> Toml.tableMap Toml._KeyString versionCodec "dev-dependencies" .= tomlSettingsDevDependencies libraryCodec :: TomlCodec Library libraryCodec = Library <$> Toml.string "source-dir" .= librarySourceDir @@ -346,6 +350,7 @@ toml2AppSettings tomlSettings release = do testSettings <- getTestSettings $ tomlSettingsTests tomlSettings buildPrefix <- makeBuildPrefix compiler release let dependencies = tomlSettingsDependencies tomlSettings + let devDependencies = tomlSettingsDevDependencies tomlSettings return AppSettings { appSettingsCompiler = compiler , appSettingsProjectName = projectName @@ -377,6 +382,7 @@ toml2AppSettings tomlSettings release = do , appSettingsExecutables = executableSettings , appSettingsTests = testSettings , appSettingsDependencies = dependencies + , appSettingsDevDependencies = devDependencies } getLibrarySettings :: Maybe Library -> IO (Maybe Library) diff --git a/test/example_packages/circular_example/fpm.toml b/test/example_packages/circular_example/fpm.toml index 034ec57..c524ce5 100644 --- a/test/example_packages/circular_example/fpm.toml +++ b/test/example_packages/circular_example/fpm.toml @@ -1,8 +1,4 @@ name = "circular_example" -[[test]] - name = "test" - source-dir = "tests" - main = "main.f90" - [test.dependencies] - circular_test = { path = "../circular_test" } +[dev-dependencies] +circular_test = { path = "../circular_test" } diff --git a/test/example_packages/circular_example/test/main.f90 b/test/example_packages/circular_example/test/main.f90 new file mode 100644 index 0000000..5b7d803 --- /dev/null +++ b/test/example_packages/circular_example/test/main.f90 @@ -0,0 +1,7 @@ +program run_tests + use hello_test, only: run_test + + implicit none + + call run_test +end program run_tests diff --git a/test/example_packages/circular_example/tests/main.f90 b/test/example_packages/circular_example/tests/main.f90 deleted file mode 100644 index 5b7d803..0000000 --- a/test/example_packages/circular_example/tests/main.f90 +++ /dev/null @@ -1,7 +0,0 @@ -program run_tests - use hello_test, only: run_test - - implicit none - - call run_test -end program run_tests -- cgit v1.2.3 From c4463d3a81b74cdfa39d0f4055c5d7993a29f889 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Sun, 31 May 2020 20:43:38 -0700 Subject: Add some documentation on dependencies to PACKAGING.md --- PACKAGING.md | 130 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 130 insertions(+) diff --git a/PACKAGING.md b/PACKAGING.md index 065dbc3..2d6fcfd 100644 --- a/PACKAGING.md +++ b/PACKAGING.md @@ -532,3 +532,133 @@ ar: creating build/debug/library/math_constants.a # gfortran (for build/debug/test/runTests) sin(pi) = 1.2246467991473532E-016 ``` + +### Adding Dependencies + +Inevitably you'll want to be able to include other libraries in your project. +fpm makes this incredibly simple, by taking care of fetching and compiling your +dependencies for you. You just tell it what your dependencies are, and where to +find them. Let's add a dependency to our library. Now our `fpm.toml` file looks +like this: + +```toml +name = "math_constants" +version = "0.1.0" +license = "MIT" +author = "Jane Programmer" +maintainer = "jane@example.com" +copyright = "2020 Jane Programmer" + +[library] +source-dir="src" + +[dependencies] +helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git" } + +[[executable]] +name="math_constants" +source-dir="app" +main="main.f90" + +[[test]] +name="runTests" +source-dir="test" +main="main.f90" +``` + +Now you can use any modules from this library anywhere in your code. Just like +this: + +```fortran +program demo + use helloff, only: create_greeting + use math_constants, only: e, pi, half_pi, two_pi + print *, 'math_constants library demo' + print *, 'pi = ', pi + print *, '2*pi = ', two_pi + print *, 'pi/2 = ', half_pi + print *, 'e = ', e + print *, create_greeting("fpm") +end program demo +``` + +And now `fpm run` will output the following: + +``` + math_constants library demo + pi = 3.1415926535897931 + 2*pi = 6.2831853071795862 + pi/2 = 1.5707963267948966 + e = 2.7182818284590451 + Hello, fpm! +``` + +Additionally, any users of your library will now automatically depend on your +dependencies too. So if you don't need that depedency for the library, like in +the above example, then you can specify it for the specific executable like +below. Then fpm will still fetch and compile it when building your executable, +but users of your library won't have to. + +```toml +name = "math_constants" +version = "0.1.0" +license = "MIT" +author = "Jane Programmer" +maintainer = "jane@example.com" +copyright = "2020 Jane Programmer" + +[library] +source-dir="src" + +[[executable]] +name="math_constants" +source-dir="app" +main="main.f90" +[executable.dependencies] +helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git" } + + +[[test]] +name="runTests" +source-dir="test" +main="main.f90" +``` + +You can also specify dependencies for your tests in a similar way, with +`[test.dependencies]` instead of `[executable.dependencies]`. There's also +another option for test dependencies. The below example makes the dependencies +available for all the tests, but again your users won't depend on these. + +```toml +name = "math_constants" +version = "0.1.0" +license = "MIT" +author = "Jane Programmer" +maintainer = "jane@example.com" +copyright = "2020 Jane Programmer" + +[library] +source-dir="src" + +[dev-dependencies] +helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git" } + +[[executable]] +name="math_constants" +source-dir="app" +main="main.f90" + +[[test]] +name="runTests" +source-dir="test" +main="main.f90" +``` + +You can also be specific about which version of a dependency you'd like. You can +specify a branch to use like `helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git", branch = "master" }`, +or a tag like `helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git", tag = "v1.2.3" }`, +or even a specific commit like `helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git", rev = "a1b2c3" }`. +You can even specify the path to another folder, if for example you've got another +fpm package in the same repository. Like this: `helloff = { path = "helloff" }`. +Note that you should *not* specify paths outside of your repository, or things +won't work for your users. -- cgit v1.2.3 From 3a4f1dbbb8f05c9f00807d06724490b232e56ac7 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Mon, 1 Jun 2020 08:01:32 -0700 Subject: Run auto-format --- src/Fpm.hs | 79 ++++++++++++++++++++++++++++++++++---------------------------- 1 file changed, 44 insertions(+), 35 deletions(-) diff --git a/src/Fpm.hs b/src/Fpm.hs index 970f178..3903e5e 100644 --- a/src/Fpm.hs +++ b/src/Fpm.hs @@ -198,7 +198,9 @@ build settings = do ((map snd executableDepends) ++ (map snd localDependencies)) ) executables - devDependencies <- fetchExecutableDependencies maybeTree (appSettingsDevDependencies settings) >>= buildDependencies buildPrefix compiler flags + devDependencies <- + fetchExecutableDependencies maybeTree (appSettingsDevDependencies settings) + >>= buildDependencies buildPrefix compiler flags mapM_ (\Executable { executableSourceDir = sourceDir, executableMainFile = mainFile, executableName = name, executableDependencies = dependencies } -> do @@ -207,14 +209,20 @@ build settings = do >>= buildDependencies buildPrefix compiler flags buildProgram sourceDir - ((map fst executableDepends) ++ (map fst devDependencies) ++ (map fst localDependencies)) + ( (map fst executableDepends) + ++ (map fst devDependencies) + ++ (map fst localDependencies) + ) [".f90", ".f", ".F", ".F90", ".f95", ".f03"] (buildPrefix sourceDir) compiler flags name mainFile - ((map snd executableDepends) ++ (map snd devDependencies) ++ (map snd localDependencies)) + ( (map snd executableDepends) + ++ (map snd devDependencies) + ++ (map snd localDependencies) + ) ) tests @@ -266,7 +274,8 @@ settingsCodec = .= tomlSettingsTests <*> Toml.tableMap Toml._KeyString versionCodec "dependencies" .= tomlSettingsDependencies - <*> Toml.tableMap Toml._KeyString versionCodec "dev-dependencies" .= tomlSettingsDevDependencies + <*> Toml.tableMap Toml._KeyString versionCodec "dev-dependencies" + .= tomlSettingsDevDependencies libraryCodec :: TomlCodec Library libraryCodec = Library <$> Toml.string "source-dir" .= librarySourceDir @@ -349,39 +358,39 @@ toml2AppSettings tomlSettings release = do projectName testSettings <- getTestSettings $ tomlSettingsTests tomlSettings buildPrefix <- makeBuildPrefix compiler release - let dependencies = tomlSettingsDependencies tomlSettings + let dependencies = tomlSettingsDependencies tomlSettings let devDependencies = tomlSettingsDevDependencies tomlSettings return AppSettings - { appSettingsCompiler = compiler - , appSettingsProjectName = projectName - , appSettingsBuildPrefix = buildPrefix - , appSettingsFlags = if release - then - [ "-Wall" - , "-Wextra" - , "-Wimplicit-interface" - , "-fPIC" - , "-fmax-errors=1" - , "-O3" - , "-march=native" - , "-ffast-math" - , "-funroll-loops" - ] - else - [ "-Wall" - , "-Wextra" - , "-Wimplicit-interface" - , "-fPIC" - , "-fmax-errors=1" - , "-g" - , "-fbounds-check" - , "-fcheck-array-temporaries" - , "-fbacktrace" - ] - , appSettingsLibrary = librarySettings - , appSettingsExecutables = executableSettings - , appSettingsTests = testSettings - , appSettingsDependencies = dependencies + { appSettingsCompiler = compiler + , appSettingsProjectName = projectName + , appSettingsBuildPrefix = buildPrefix + , appSettingsFlags = if release + then + [ "-Wall" + , "-Wextra" + , "-Wimplicit-interface" + , "-fPIC" + , "-fmax-errors=1" + , "-O3" + , "-march=native" + , "-ffast-math" + , "-funroll-loops" + ] + else + [ "-Wall" + , "-Wextra" + , "-Wimplicit-interface" + , "-fPIC" + , "-fmax-errors=1" + , "-g" + , "-fbounds-check" + , "-fcheck-array-temporaries" + , "-fbacktrace" + ] + , appSettingsLibrary = librarySettings + , appSettingsExecutables = executableSettings + , appSettingsTests = testSettings + , appSettingsDependencies = dependencies , appSettingsDevDependencies = devDependencies } -- cgit v1.2.3