diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,9 @@ +## 0.1.0 +Initial release. + +### Major changes from original package + * Use `Language.Fortran.Util.Position.getSpan` instead of `extractExpSrcSpan`, + `extractBlockSrcSpan`. AST nodes storing location info are instances of the + `Spanned` typeclass which allows easy `SrcSpan` extraction. + * `Encoding.pprint` now `Encoding.pprint77l` + * Rewriter has moved: `Language.Fortran.Rewriter` (in fortran-src package) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ +Copyright (c) 2021 CamFort contributors + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,15 @@ +# fortran-src-extras +Various utility functions and orphan instances which may be useful when using +fortran-src. + +## Contributors +Thanks to the original package authors: + + * Jason Xu + * Anthony Burzillo + * Daniel Beer + * Aiden Jeffrey + * Raoul Hidalgo Charman + * Lukasz Kolodziejczyk + * Eric Seidel + * Darius Makovsky diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/fortran-src-extras.cabal b/fortran-src-extras.cabal new file mode 100644 --- /dev/null +++ b/fortran-src-extras.cabal @@ -0,0 +1,75 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.33.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 58acdfe9c45070482fedea0466e7e18d8b2fcb95dbe956761a628ca1a3067696 + +name: fortran-src-extras +version: 0.1.0 +synopsis: Common functions and utils for fortran-src. +description: Various utility functions and orphan instances which may be useful when using fortran-src. +category: Language +homepage: https://github.com/camfort/fortran-src-extras#readme +bug-reports: https://github.com/camfort/fortran-src-extras/issues +maintainer: thefirstmuffinman@gmail.com +license: Apache-2.0 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/camfort/fortran-src-extras + +library + exposed-modules: + Language.Fortran.Extras + Language.Fortran.Extras.Analysis + Language.Fortran.Extras.Encoding + Language.Fortran.Extras.ModFiles + Language.Fortran.Extras.ProgramFile + Language.Fortran.Extras.RunOptions + Language.Fortran.Extras.Test + other-modules: + Paths_fortran_src_extras + hs-source-dirs: + src + build-depends: + GenericPretty >=1.2.1 + , aeson >=1.2.3.0 + , base >=4.7 && <5 + , binary >=0.8.5.1 + , bytestring >=0.10.8.1 + , containers >=0.5.0.0 + , directory >=1.3.0.2 + , filepath >=1.4.1.2 + , fortran-src >=0.4.2 + , optparse-applicative >=0.14 + , text >=1.2.2.2 + , uniplate >=1.6.10 + default-language: Haskell2010 + +test-suite spec + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + AnalysisSpec + ExtrasSpec + Paths_fortran_src_extras + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-tool-depends: + hspec-discover:hspec-discover + build-depends: + base >=4.7 && <5 + , fortran-src >=0.4.2 + , fortran-src-extras + , hspec >=2.2 && <3 + , silently >=1.2 && <1.3 + , uniplate >=1.6.10 + default-language: Haskell2010 diff --git a/src/Language/Fortran/Extras.hs b/src/Language/Fortran/Extras.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fortran/Extras.hs @@ -0,0 +1,218 @@ +module Language.Fortran.Extras where + +import Control.Exception ( try + , SomeException + ) +import Data.Data ( Data ) +import Data.List ( find ) +import Data.Maybe ( fromMaybe + , mapMaybe + ) +import Data.Generics.Uniplate.Data ( universeBi ) +import Language.Fortran.AST ( A0 + , Block + , ProgramFile + , Statement + , ProgramUnit(..) + , ProgramUnitName(..) + ) +import Language.Fortran.Analysis ( Analysis + , puSrcName + ) +import Language.Fortran.Version ( FortranVersion(..) ) +import System.Exit ( ExitCode(..) + , exitWith + ) +import System.IO ( hPutStr + , hPutStrLn + , stderr + ) +import Options.Applicative +import qualified Language.Fortran.Extras.ProgramFile + as P +import qualified Language.Fortran.Extras.Analysis + as A +import Language.Fortran.Extras.ModFiles + ( decodeModFiles ) +import Language.Fortran.Extras.RunOptions + ( unwrapFortranSrcOptions + , getFortranSrcRunOptions + , getRunOptions + , FortranSrcRunOptions(..) + , RunOptions(..) + ) + +-- | Get a list of all 'Block's in a 'ProgramFile' +allB :: Data a => ProgramFile a -> [Block a] +allB = universeBi + +-- | Get a list of all 'Statement's in a 'ProgramFile' +allS :: Data a => ProgramFile a -> [Statement a] +allS = universeBi + +-- | Get a list of all 'ProgramUnit's in a 'ProgramFile' +allPU :: Data a => ProgramFile a -> [ProgramUnit a] +allPU = universeBi + +-- | Get a list of all 'Block's in a 'ProgramUnit' +allPUB :: Data a => ProgramUnit a -> [Block a] +allPUB = universeBi + +-- | Get a list of all 'Statement's in a 'ProgramUnit' +allPUS :: Data a => ProgramUnit a -> [Statement a] +allPUS = universeBi + +-- | Given a 'ProgramFile' find a 'ProgramUnit' with a particular 'ProgramUnitName' +findPU' + :: Data a + => ProgramUnitName + -> ProgramFile (Analysis a) + -> Maybe (ProgramUnit (Analysis a)) +findPU' n = find (\pu -> puSrcName pu == n) . allPU + +-- | Given a 'ProgramFile' find a 'ProgramUnit' with a particular name +findPU + :: Data a + => String + -> ProgramFile (Analysis a) + -> Maybe (ProgramUnit (Analysis a)) +findPU n = findPU' $ Named n + +-- | Get a 'ProgramFile' from version and path specified in 'FortranSrcRunOptions' +programFile :: FortranSrcRunOptions -> IO (ProgramFile A0) +programFile options = do + (pfPath, pfContents, pfIncludes, fVersion) <- unwrapFortranSrcOptions options + case fVersion of + Fortran77Legacy -> + P.versionedExpandedProgramFile fVersion pfIncludes pfPath pfContents + _ -> return $ P.versionedProgramFile fVersion pfPath pfContents + +-- | Get a 'ProgramFile' with 'Analysis' from version and path specified +-- in 'FortranSrcRunOptions' +programAnalysis :: FortranSrcRunOptions -> IO (ProgramFile (Analysis A0)) +programAnalysis options = do + (pfPath, pfContents, pfIncludes, fVersion) <- unwrapFortranSrcOptions options + case fVersion of + Fortran77Legacy -> + A.versionedExpandedProgramAnalysis fVersion pfIncludes pfPath pfContents + _ -> if null pfIncludes + then return $ A.versionedProgramAnalysis fVersion pfPath pfContents + else do + pfMods <- decodeModFiles pfIncludes + return $ A.versionedProgramAnalysisWithMods fVersion + pfMods + pfPath + pfContents + +-- | Parse arguments and return 'ProgramFile' +-- +-- This function has the purpose of being the general entry-point for the `fortran-src-tools` tools. +-- It handles parsing the common arguments and then returns a 'ProgramFile' that the tool can then use to +-- do further processing. +-- +-- This function takes in two arguments, namely: +-- +-- * A description of the program that shows up when the program is invoked incorrectly +-- @ +-- $ some-fortran-tool +-- Missing: (-v|--fortranVersion VERSION) PATH +-- +-- Usage: vars (-v|--fortranVersion VERSION) [-I|--include DIRECTORY] PATH +-- THIS IS WHERE THE DESCRIPTION GOES +-- @ +-- +-- * A header that is shown when the user passes the `--help` argument to the tool (note that this does +-- not show up when the program is invoked incorrectly) +-- @ +-- $ some-fortran-tool --help +-- THIS IS WHERE THE HEADER GOES +-- +-- Usage: vars (-v|--fortranVersion VERSION) [-I|--include DIRECTORY] PATH +-- THIS IS WHERE THE DESCRIPTION GOES +-- +-- Available options: +-- -h,--help Show this help text +-- -v,--fortranVersion VERSION +-- Fortran version to use, format: +-- Fortran[66/77/BigIron/77Legacy/77Extended/90] +-- -I,--include DIRECTORY Directory to include files from +-- @ +getProgramFile :: String -> String -> IO (ProgramFile A0) +getProgramFile programDescription programHeader = do + options <- getFortranSrcRunOptions programDescription programHeader + programFile options + +-- | Parse arguments and return a 'ProgramFile' with 'Analysis' +-- +-- This function takes the same arguments as 'getProgramFile', however it will return an 'Analysis' object +-- within the 'ProgramFile' monad. If any `-I DIR` arguments were specified when invoking the tool, this +-- function will ensure that any module files located in this directory are loaded and incorporated into the +-- analysis. +getProgramAnalysis :: String -> String -> IO (ProgramFile (Analysis A0)) +getProgramAnalysis programDescription programHeader = do + options <- getFortranSrcRunOptions programDescription programHeader + programAnalysis options + +-- | Helper to print out exceptions with the name of the file being processed +errorHandler :: String -> Either SomeException () -> IO () +errorHandler filename (Left e) = do + hPutStrLn stderr $ "Caught exception in file: " ++ filename + hPutStr stderr . unlines . map (" " ++) . lines $ show e + exitWith $ ExitFailure 2 +errorHandler _ (Right _) = return () + +-- | Given a program description, a program header, and a handler that +-- takes a 'ProgramFile', this function generates the 'ProgramFile' +-- and passes it to the handler, while catching any exceptions that +-- occur within either the parsing of the 'ProgramFile' itself +-- or while the handler is processing +withProgramFile :: String -> String -> (ProgramFile A0 -> IO ()) -> IO () +withProgramFile programDescription programHeader handler = do + options <- getFortranSrcRunOptions programDescription programHeader + results <- try $ programFile options >>= handler + errorHandler (path options) results + +-- | Given a program description, a program header, and a handler that +-- takes a 'ProgramFile', this function generates the 'ProgramFile' +-- annotated with 'Analysis' and passes it to the handler, +-- while catching any exceptions that occur within either the parsing +-- of the 'ProgramFile' itself or while the handler is processing +withProgramAnalysis + :: String -> String -> (ProgramFile (Analysis A0) -> IO ()) -> IO () +withProgramAnalysis programDescription programHeader handler = do + options <- getFortranSrcRunOptions programDescription programHeader + results <- try $ programAnalysis options >>= handler + errorHandler (path options) results + +-- | Given a program description, a program header, a parser for +-- tool CLI options, and a handler that takes tool CLI options object, +-- and a 'ProgramFile', this function generates tool CLI options object, +-- and a 'ProgramFile' annotated with 'Analysis', and passes them to the +-- handler, while catching any exceptions that occurs during handler +-- processing +withToolOptionsAndProgramAnalysis + :: String + -> String + -> Parser a + -> (a -> ProgramFile (Analysis A0) -> IO ()) + -> IO () +withToolOptionsAndProgramAnalysis programDescription programHeader toolOptsParser handler + = do + options <- getRunOptions programDescription programHeader toolOptsParser + let (fortranSrcOptions, toolOptions) = + (fortranSrcOpts options, toolOpts options) + results <- try $ programAnalysis fortranSrcOptions >>= handler toolOptions + errorHandler (path fortranSrcOptions) results + +-- | Given a 'ProgramUnit' return a pair of the name of the unit as well as the unit itself +-- only if the 'ProgramUnit' is a 'PUMain', 'PUSubroutine', or a 'PUFunction' +namedProgramUnit :: Data a => ProgramUnit a -> Maybe (String, ProgramUnit a) +namedProgramUnit pu@(PUMain _ _ mn _ _) = Just (fromMaybe "MAIN" mn, pu) +namedProgramUnit pu@(PUSubroutine _ _ _ n _ _ _) = Just (n, pu) +namedProgramUnit pu@(PUFunction _ _ _ _ n _ _ _ _) = Just (n, pu) +namedProgramUnit _ = Nothing + +-- | Given a 'ProgramFile' return all of the named 'ProgramUnits' within the file, i.e. +-- 'PUMain's, 'PUSubroutine's, or 'PUFunction's +namedProgramUnits :: Data a => ProgramFile a -> [(String, ProgramUnit a)] +namedProgramUnits = mapMaybe namedProgramUnit . allPU diff --git a/src/Language/Fortran/Extras/Analysis.hs b/src/Language/Fortran/Extras/Analysis.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fortran/Extras/Analysis.hs @@ -0,0 +1,85 @@ +-- | This module exposes functions obtaining both explicitly versioned +-- and implicitly versionied analyses of source code. +module Language.Fortran.Extras.Analysis + ( versionedExpandedProgramAnalysis + , versionedProgramAnalysis + , versionedProgramAnalysisWithMods + , programAnalysis + , programAnalysisWithMods + ) +where + +import qualified Data.ByteString.Char8 as B +import Language.Fortran.AST ( A0 + , ProgramFile + ) +import Language.Fortran.Analysis ( Analysis + , initAnalysis + ) +import Language.Fortran.Analysis.Types + ( analyseTypes + , analyseTypesWithEnv + ) +import Language.Fortran.Version ( FortranVersion(..) ) +import Language.Fortran.Util.ModFile ( combinedTypeEnv + , ModFiles + ) + +import Language.Fortran.Extras.ProgramFile + ( programFile + , versionedProgramFile + , versionedExpandedProgramFile + ) + +-- | Obtain the analysis of the 'ProgramFile'. +programAnalysis' :: ProgramFile A0 -> ProgramFile (Analysis A0) +programAnalysis' = fst . analyseTypes . initAnalysis + +-- | Obtain the analysis of the 'ProgramFile' and modules. +programAnalysisWithMods' + :: ModFiles -> ProgramFile A0 -> ProgramFile (Analysis A0) +programAnalysisWithMods' mods = + let tenv = combinedTypeEnv mods + in fst . analyseTypesWithEnv tenv . initAnalysis + +-- | Obtain the analysis of source code with imports expanded using +-- a specific version of the parser. +versionedExpandedProgramAnalysis + :: FortranVersion + -> [String] + -> String + -> B.ByteString + -> IO (ProgramFile (Analysis A0)) +versionedExpandedProgramAnalysis version importDirs path contents = do + pf <- versionedExpandedProgramFile version importDirs path contents + return $ programAnalysis' pf + +-- | Obtain the analysis of source code using an explicit version of +-- the parser. +versionedProgramAnalysis + :: FortranVersion -> String -> B.ByteString -> ProgramFile (Analysis A0) +versionedProgramAnalysis version path contents = + programAnalysis' $ versionedProgramFile version path contents + +-- | Obtain the analysis of source code and module files using an +-- explicit version of the parser. +versionedProgramAnalysisWithMods + :: FortranVersion + -> ModFiles + -> String + -> B.ByteString + -> ProgramFile (Analysis A0) +versionedProgramAnalysisWithMods version mods path contents = + programAnalysisWithMods' mods $ versionedProgramFile version path contents + +-- | Obtain the analysis of source code using an implicit version of +-- the parser. +programAnalysis :: String -> B.ByteString -> ProgramFile (Analysis A0) +programAnalysis path contents = programAnalysis' $ programFile path contents + +-- | Obtain the analysis of source code and module files using an +-- implicit version of the parser. +programAnalysisWithMods + :: ModFiles -> String -> B.ByteString -> ProgramFile (Analysis A0) +programAnalysisWithMods mods path contents = + programAnalysisWithMods' mods $ programFile path contents diff --git a/src/Language/Fortran/Extras/Encoding.hs b/src/Language/Fortran/Extras/Encoding.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fortran/Extras/Encoding.hs @@ -0,0 +1,42 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | Utils and Aeson orphan instances for common types in the AST. +module Language.Fortran.Extras.Encoding where + +import Data.Aeson ( ToJSON + , FromJSON + , encode + ) +import Language.Fortran.AST ( BaseType + , CharacterLen + ) +import Language.Fortran.Version ( FortranVersion(..) ) +import Language.Fortran.PrettyPrint ( IndentablePretty + , pprintAndRender + ) +import Language.Fortran.Util.Position ( Position + , SrcSpan + ) +import Data.ByteString.Lazy ( ByteString ) + +-- | Provide a wrapper for the 'Data.Aeson.encode' function to allow +-- indirect use in modules importing +-- 'Language.Fortran.Extras.Encoding'. +commonEncode :: ToJSON a => a -> ByteString +commonEncode = encode + +instance ToJSON Position +instance FromJSON Position + +instance ToJSON SrcSpan +instance FromJSON SrcSpan + +instance ToJSON CharacterLen +instance FromJSON CharacterLen + +instance ToJSON BaseType +instance FromJSON BaseType + +-- | Render some AST element to a 'String' using F77 legacy mode. +pprint77l :: IndentablePretty a => a -> String +pprint77l s = pprintAndRender Fortran77Legacy s Nothing diff --git a/src/Language/Fortran/Extras/ModFiles.hs b/src/Language/Fortran/Extras/ModFiles.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fortran/Extras/ModFiles.hs @@ -0,0 +1,50 @@ +-- | This module provides functions for handling FORTRAN source modules. +module Language.Fortran.Extras.ModFiles + ( isModFile + , decodeModFiles + ) +where + +import Control.Monad ( foldM + , forM + ) +import Data.Binary ( decodeFileOrFail ) +import Language.Fortran.Util.ModFile ( emptyModFile + , emptyModFiles + , ModFiles + , modFileSuffix + ) +import Language.Fortran.Util.Files ( rGetDirContents ) +import System.FilePath ( takeExtension + , () + ) + +-- | Return TRUE iff the file extension indicates a module file. +isModFile :: String -> Bool +isModFile = (== modFileSuffix) . takeExtension + +-- | Read suspected module files from a list of files and obtain the +-- 'Language.Fortran.Util.ModFiles' object populated by their contents. +-- +-- TODO: almost equal to Language.Fortran.Analysis.ModGraph.decodeModFiles +decodeModFiles :: [FilePath] -> IO ModFiles +decodeModFiles = foldM + (\modFiles d -> do + modFileNames <- filter isModFile `fmap` rGetDirContents d + addedModFiles <- forM modFileNames $ \modFileName -> do + eResult <- decodeFileOrFail (d modFileName) + case eResult of + Left (offset, msg) -> do + putStrLn + $ modFileName + ++ ": Error at offset " + ++ show offset + ++ ": " + ++ msg + return emptyModFile + Right modFile -> do + putStrLn $ modFileName ++ ": successfully parsed precompiled file." + return modFile + return $ addedModFiles ++ modFiles + ) + emptyModFiles diff --git a/src/Language/Fortran/Extras/ProgramFile.hs b/src/Language/Fortran/Extras/ProgramFile.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fortran/Extras/ProgramFile.hs @@ -0,0 +1,51 @@ +-- | This module exposes functions obtaining +-- 'Language.Fortran.AST.ProgramFile' from a valid file name. +module Language.Fortran.Extras.ProgramFile where + +import qualified Data.ByteString.Char8 as B +import Language.Fortran.AST ( A0 + , ProgramFile + ) +import Language.Fortran.Version ( deduceFortranVersion + , FortranVersion(..) + ) +import Language.Fortran.Parser.Any ( parserVersions + ) +import Language.Fortran.ParserMonad ( fromParseResult + , fromRight + ) +import Language.Fortran.Parser.Fortran77 + ( legacy77ParserWithIncludes ) +import System.FilePath ( takeDirectory ) + +-- | Obtain a 'ProgramFile' from a specific version of the parser with include +-- statements expanded. +-- +-- TODO: cover all FortranVersions, instead of just Fortran77Legacy +versionedExpandedProgramFile + :: FortranVersion -> [String] -> String -> B.ByteString -> IO (ProgramFile A0) +versionedExpandedProgramFile version importDirs path contents = case version of + Fortran77Legacy -> + let parserF b s = + fromRight + . fromParseResult + <$> legacy77ParserWithIncludes (takeDirectory path : importDirs) b s + in parserF contents path + _ -> error ("Unsupported version: " ++ show version) + +-- | Obtain a 'ProgramFile' from a specific version of the parser. +versionedProgramFile + :: FortranVersion -> String -> B.ByteString -> ProgramFile A0 +versionedProgramFile version path contents = + let Just parserF = lookup version parserVersions + pf = fromRight $ parserF contents path -- Parse contents of file + in pf + +-- | Obtain a 'ProgramFile' from a parser version deduced by inspection +-- of the file extension. +-- +-- For example "foo.f90" will deduce the 'Fortran90' Parser version. +programFile :: String -> B.ByteString -> ProgramFile A0 +programFile path contents = + let version = deduceFortranVersion path -- suggest version from file extension + in versionedProgramFile version path contents diff --git a/src/Language/Fortran/Extras/RunOptions.hs b/src/Language/Fortran/Extras/RunOptions.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fortran/Extras/RunOptions.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE FlexibleInstances #-} + +-- | This module is responsible for handling CLI options +module Language.Fortran.Extras.RunOptions + ( FortranSrcRunOptions(..) + , getFortranSrcRunOptions + , unwrapFortranSrcOptions + , RunOptions(..) + , getRunOptions + ) +where + +import qualified Data.ByteString.Char8 as B +import Data.Char ( toLower ) +import Data.List ( isInfixOf ) +import Data.Semigroup ( (<>) ) +import Language.Fortran.Version ( FortranVersion(..) + , selectFortranVersion + ) +import Options.Applicative + +import Language.Fortran.Util.Files + ( flexReadFile ) + +-- | Holds fortran-src specific CLI options. +-- This includes the version of the parser, included files and the path +-- of the source +data FortranSrcRunOptions = FortranSrcRunOptions + { version :: !FortranVersion + , includes :: ![String] + , path :: !String + } deriving Show + +-- | Provided version, includes and path strings, this functon maps them to +-- 'FortranSrcRunOptions' +-- +-- Note that this will throw an exception on an unrecognized version string. +toFortranSrcOptions :: String -> [String] -> String -> FortranSrcRunOptions +toFortranSrcOptions verStr = + let (Just ver) = selectFortranVersion verStr + in FortranSrcRunOptions ver + +-- | Definition of parser for 'FortranSrcRunOptions' +fortranSrcRunOptionsParser :: Parser FortranSrcRunOptions +fortranSrcRunOptionsParser = + toFortranSrcOptions + <$> strOption + ( short 'v' + <> long "fortranVersion" + <> metavar "VERSION" + <> help + "Fortran version to use, format: Fortran[66/77/77l/77e/90/95/03/08]" + ) + <*> many + (strOption + (short 'I' <> long "include" <> metavar "DIRECTORY" <> help + "Directory to include files from" + ) + ) + <*> argument str (metavar "PATH") + +-- | Given description and header, decorate fortran-src options parser with +-- info details +fortranSrcRunOptionsInfo :: String -> String -> ParserInfo FortranSrcRunOptions +fortranSrcRunOptionsInfo programDescription headerDescription = info + (helper <*> fortranSrcRunOptionsParser) + (fullDesc <> progDesc programDescription <> header headerDescription) + +-- | Given description and header, execute fortran-src options parser +-- and get the 'FortranSrcRunOptions' +getFortranSrcRunOptions :: String -> String -> IO FortranSrcRunOptions +getFortranSrcRunOptions programDescription headerDescription = + execParser $ fortranSrcRunOptionsInfo programDescription headerDescription + +-- | Obtain path, contents, include dirs and 'FortranVersion' +-- from 'FortranSrcRunOptions' +unwrapFortranSrcOptions + :: FortranSrcRunOptions -> IO (String, B.ByteString, [String], FortranVersion) +unwrapFortranSrcOptions options = do + let p = path options + c <- flexReadFile p + let i = includes options + v = version options + return (p, c, i, v) + +-- | Holds 'FortranSrcRunOptions' and additional tool specific CLI options +data RunOptions a = RunOptions + { fortranSrcOpts :: FortranSrcRunOptions + , toolOpts :: a + } deriving Show + +-- | Given decription, header and tool options parser, decorate options +-- with info details +runOptionsInfo :: String -> String -> Parser a -> ParserInfo (RunOptions a) +runOptionsInfo programDescription headerDescription toolOptsParser = info + (helper <*> liftA2 RunOptions fortranSrcRunOptionsParser toolOptsParser) + (fullDesc <> progDesc programDescription <> header headerDescription) + +-- | Given description, header and tool options parser, execute options parser +-- and get the 'RunOptions' +getRunOptions :: String -> String -> Parser a -> IO (RunOptions a) +getRunOptions programDescription headerDescription toolOptsParser = + execParser + $ runOptionsInfo programDescription headerDescription toolOptsParser diff --git a/src/Language/Fortran/Extras/Test.hs b/src/Language/Fortran/Extras/Test.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fortran/Extras/Test.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE OverloadedStrings #-} +module Language.Fortran.Extras.Test where + +import qualified Data.ByteString.Lazy.Char8 as BC +import Language.Fortran.Analysis ( Analysis ) +import Language.Fortran.AST ( A0 + , ProgramFile + ) +import Language.Fortran.Version ( FortranVersion(..) ) + +import Language.Fortran.Extras.Analysis + ( versionedExpandedProgramAnalysis + ) +import Language.Fortran.Extras.ProgramFile + ( versionedExpandedProgramFile ) +import Language.Fortran.Util.Files + ( flexReadFile ) + +getTestProgramFile :: String -> IO (ProgramFile A0) +getTestProgramFile p = do + cts <- flexReadFile p + versionedExpandedProgramFile Fortran77Legacy [] p cts + +getTestProgramFileIncludes :: String -> [String] -> IO (ProgramFile A0) +getTestProgramFileIncludes p incls = do + cts <- flexReadFile p + versionedExpandedProgramFile Fortran77Legacy incls p cts + +getTestProgramAnalysis :: String -> IO (ProgramFile (Analysis A0)) +getTestProgramAnalysis p = do + cts <- flexReadFile p + versionedExpandedProgramAnalysis Fortran77Legacy [] p cts + +getTestProgramAnalysisIncludes + :: String -> [String] -> IO (ProgramFile (Analysis A0)) +getTestProgramAnalysisIncludes p incls = do + cts <- flexReadFile p + versionedExpandedProgramAnalysis Fortran77Legacy incls p cts + +-- | Utility function to compare file content +compareFile :: FilePath -> FilePath -> IO Bool +compareFile expected actual = do + c1 <- BC.readFile expected + c2 <- BC.readFile actual + compareByteString c1 c2 + +compareByteString :: BC.ByteString -> BC.ByteString -> IO Bool +compareByteString expected actual = if expected == actual + then return True + else do + BC.putStrLn "<<<<<<< EXPECTED" + BC.putStrLn expected + BC.putStrLn ">>>>>>> ACTUAL" + BC.putStrLn actual + return False diff --git a/test/AnalysisSpec.hs b/test/AnalysisSpec.hs new file mode 100644 --- /dev/null +++ b/test/AnalysisSpec.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE TypeApplications #-} + +module AnalysisSpec + ( spec + ) +where + +import Test.Hspec +import Data.Maybe ( isJust ) +import Language.Fortran.AST ( A0 + , ProgramFile + , Expression(..) + , Statement(..) + , Value(..) + ) +import Language.Fortran.Analysis ( Analysis ) +import Language.Fortran.Version ( FortranVersion(..) ) + +import Language.Fortran.Extras.Analysis + ( versionedProgramAnalysis + , versionedExpandedProgramAnalysis + ) +import Language.Fortran.Util.Files + ( flexReadFile ) +import Data.Generics.Uniplate.Data ( universeBi ) + +wasIncluded :: ProgramFile (Analysis A0) -> String -> Bool +wasIncluded pa filename = any + isJust + [ included + | StInclude _ _ (ExpValue _ _ (ValString incFilename)) included <- (universeBi pa :: [Statement (Analysis A0)]) + , incFilename == filename + ] + +spec :: Spec +spec = describe "ProgramAnalysis" $ do + it "versionedProgramAnalysis - no includes expansion" $ do + let path = "test/input_data/analysis/relative_include/include.f" + pa <- versionedProgramAnalysis Fortran77Legacy path <$> flexReadFile path + wasIncluded pa "includee.f" `shouldBe` False + + it "versionedExpandedProgramAnalysis - with expanded includes" $ do + let path = "test/input_data/analysis/with_include_path/include.f" + idirs = ["test/input_data/analysis/with_include_path/includes"] + contents <- flexReadFile path + pa <- versionedExpandedProgramAnalysis Fortran77Legacy idirs path contents + wasIncluded pa "includee.f" `shouldBe` True + + it "versionedExpandedProgramAnalysis - with expanded relative includes" $ do + let path = "test/input_data/analysis/relative_include/include.f" + contents <- flexReadFile path + pa <- versionedExpandedProgramAnalysis Fortran77Legacy [] path contents + wasIncluded pa "includee.f" `shouldBe` True diff --git a/test/ExtrasSpec.hs b/test/ExtrasSpec.hs new file mode 100644 --- /dev/null +++ b/test/ExtrasSpec.hs @@ -0,0 +1,28 @@ +module ExtrasSpec where + +import Test.Hspec + +import Control.Exception +import System.Exit ( ExitCode ) +import System.IO ( stderr + , stdout + ) +import System.IO.Silently ( hCapture_ ) + +import Language.Fortran.Extras + ( errorHandler ) + +spec :: Spec +spec = describe "errorHandler" $ do + let + doErr s = do + _ <- + try $ errorHandler "foo" . Left . toException $ AssertionFailed s :: IO + (Either ExitCode ()) + return () + it "Prints to stderr" $ do + out <- hCapture_ [stderr] $ doErr "stderr" + null out `shouldBe` False + it "Doesn't print to stdout" $ do + out <- hCapture_ [stdout] $ doErr "stdout" + null out `shouldBe` True diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}