fortran-src 0.16.8 → 0.16.9
raw patch · 17 files changed
+168/−550 lines, 17 filesnew-uploaderPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Language.Fortran.Parser.Free.Lexer: TAutomatic :: SrcSpan -> Token
+ Language.Fortran.Parser.Free.Lexer: TEndMap :: SrcSpan -> Token
+ Language.Fortran.Parser.Free.Lexer: TEndStructure :: SrcSpan -> Token
+ Language.Fortran.Parser.Free.Lexer: TEndUnion :: SrcSpan -> Token
+ Language.Fortran.Parser.Free.Lexer: TMap :: SrcSpan -> Token
+ Language.Fortran.Parser.Free.Lexer: TStatic :: SrcSpan -> Token
+ Language.Fortran.Parser.Free.Lexer: TStructure :: SrcSpan -> Token
+ Language.Fortran.Parser.Free.Lexer: TUnion :: SrcSpan -> Token
+ Language.Fortran.Version: Fortran90Legacy :: FortranVersion
Files
- CHANGELOG.md +3/−0
- README.md +1/−1
- app/Main.hs +2/−2
- fortran-src.cabal +2/−9
- src/Language/Fortran/Parser/Free/Fortran90.y +46/−0
- src/Language/Fortran/Parser/Free/Lexer.x +19/−0
- src/Language/Fortran/PrettyPrint.hs +3/−3
- src/Language/Fortran/Util/Files.hs +1/−1
- src/Language/Fortran/Version.hs +3/−0
- test-data/module/leaf.mod binary
- test-data/pragma.f90 +0/−30
- test-data/pragma.f90.expected +0/−292
- test-data/small.f90 +0/−17
- test-data/small.f90.expected +0/−175
- test-data/st.expected +0/−10
- test-data/st2.expected +0/−5
- test/Language/Fortran/Parser/Free/Fortran90Spec.hs +88/−5
CHANGELOG.md view
@@ -1,3 +1,6 @@+### 0.16.9+ * Added support for legacy features in Fortran 90 free-form style+ ### 0.16.8 * Package build support up to GHC 9.12 * Fixed pretty printing of array semantic types
README.md view
@@ -64,7 +64,7 @@ ``` Usage: fortran-src [OPTION...] <file> --version show fortran-src version- -v VERSION, -F VERSION --fortranVersion=VERSION Fortran version to use, format: Fortran[66/77/77Legacy/77Extended/90/2003]+ -v VERSION, -F VERSION --fortranVersion=VERSION Fortran version to use, format: Fortran[66/77/77Legacy/77Extended/90/90Legacy/2003] -a ACTION --action=ACTION choose the action, possible values: lex|parse -t --typecheck parse and run typechecker -R --rename parse and rename variables
app/Main.hs view
@@ -51,7 +51,7 @@ programName = "fortran-src" showVersion :: String-showVersion = "0.16.8"+showVersion = "0.16.9" main :: IO () main = do@@ -348,7 +348,7 @@ , Option ['v','F'] ["fortranVersion"] (ReqArg (\v opts -> opts { fortranVersion = selectFortranVersion v }) "VERSION")- "Fortran version to use, format: Fortran[66/77/77Legacy/77Extended/90/2003]"+ "Fortran version to use, format: Fortran[66/77/77Legacy/77Extended/90/90Legacy/2003]" , Option ['a'] ["action"] (ReqArg (\a opts -> opts { action = read a }) "ACTION")
fortran-src.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.38.1.+-- This file has been generated from package.yaml by hpack version 0.39.1. -- -- see: https://github.com/sol/hpack name: fortran-src-version: 0.16.8+version: 0.16.9 synopsis: Parsers and analyses for Fortran standards 66, 77, 90, 95 and 2003 (partial). description: Provides lexing, parsing, and basic analyses of Fortran code covering standards: FORTRAN 66, FORTRAN 77, Fortran 90, Fortran 95, Fortran 2003 (partial) and some legacy extensions. Includes data flow and basic block analysis, a renamer, and type analysis. For example usage, see the @<https://hackage.haskell.org/package/camfort CamFort>@ project, which uses fortran-src as its front end. category: Language@@ -27,12 +27,9 @@ test-data/f77-include/foo.f test-data/f77-include/no-newline/foo.f test-data/module/leaf.f90- test-data/module/leaf.mod test-data/module/mid1.f90 test-data/module/mid2.f90 test-data/module/top.f90- test-data/pragma.f90- test-data/pragma.f90.expected test-data/rewriter/replacementsmap-columnlimit/001_foo.f test-data/rewriter/replacementsmap-columnlimit/001_foo.f.expected test-data/rewriter/replacementsmap-columnlimit/002_other.f@@ -64,10 +61,6 @@ test-data/rewriter/replacementsmap-simple/005_unicode.f test-data/rewriter/replacementsmap-simple/005_unicode.f.expected test-data/rewriter/temp-failure/fail.f- test-data/small.f90- test-data/small.f90.expected- test-data/st.expected- test-data/st2.expected source-repository head type: git
src/Language/Fortran/Parser/Free/Fortran90.y view
@@ -21,6 +21,7 @@ import Prelude hiding ( EQ, LT, GT ) -- Same constructors exist in the AST import Data.Either ( partitionEithers ) import qualified Data.List as List+import Data.Maybe ( fromJust, isNothing, isJust ) } @@ -87,6 +88,14 @@ endBlockData { TEndBlockData _ } module { TModule _ } endModule { TEndModule _ }+ structure { TStructure _ }+ union { TUnion _ }+ map { TMap _ }+ endstructure { TEndStructure _ }+ endunion { TEndUnion _ }+ endmap { TEndMap _ }+ automatic { TAutomatic _ }+ static { TStatic _ } contains { TContains _ } use { TUse _ } only { TOnly _ }@@ -528,6 +537,43 @@ -- Must be fixed in the future. TODO | format blob { let TBlob s blob = $2 in StFormatBogus () (getTransSpan $1 s) blob }+| structure MAYBE_NAME NEWLINE STRUCTURE_DECLARATIONS endstructure+ { StStructure () (getTransSpan $1 $5) $2 (fromReverseList $4) }+| automatic INITIALIZED_DECLARATOR_LIST+ { let alist = fromReverseList $2+ in StAutomatic () (getTransSpan $1 alist) alist }+| static INITIALIZED_DECLARATOR_LIST+ { let alist = fromReverseList $2+ in StStatic () (getTransSpan $1 alist) alist }++MAYBE_NAME :: { Maybe Name }+: '/' NAME '/' { Just $2 }+| {- empty -} { Nothing }++STRUCTURE_DECLARATIONS :: { [StructureItem A0] }+: STRUCTURE_DECLARATIONS STRUCTURE_DECLARATION_STATEMENT+ { if isNothing $2 then $1 else fromJust $2 : $1 }+| STRUCTURE_DECLARATION_STATEMENT { if isNothing $1 then [] else [fromJust $1] }++STRUCTURE_DECLARATION_STATEMENT :: { Maybe (StructureItem A0) }+: DECLARATION_STATEMENT NEWLINE+ { let StDeclaration () s t attrs decls = $1+ in Just $ StructFields () s t attrs decls }+| union NEWLINE UNION_MAPS endunion NEWLINE+ { Just $ StructUnion () (getTransSpan $1 $5) (fromReverseList $3) }+| structure MAYBE_NAME NAME NEWLINE STRUCTURE_DECLARATIONS endstructure NEWLINE+ { Just $ StructStructure () (getTransSpan $1 $7) $2 $3 (fromReverseList $5) }+| comment NEWLINE { Nothing }++UNION_MAPS :: { [ UnionMap A0 ] }+: UNION_MAPS UNION_MAP { if isNothing $2 then $1 else fromJust $2 : $1 }+| UNION_MAP { if isNothing $1 then [] else [fromJust $1] }++UNION_MAP :: { Maybe (UnionMap A0) }+: map NEWLINE STRUCTURE_DECLARATIONS endmap NEWLINE+ { Just $ UnionMap () (getTransSpan $1 $5) (fromReverseList $3) }+| comment NEWLINE { Nothing }+ EXECUTABLE_STATEMENT :: { Statement A0 } : allocate '(' DATA_REFS MAYBE_ALLOC_OPT_LIST ')'
src/Language/Fortran/Parser/Free/Lexer.x view
@@ -146,6 +146,14 @@ <0,scI> "return" { addSpan TReturn } <0> "entry" { addSpan TEntry } <0> "include" { addSpan TInclude }+<0> "structure" / { legacy90P } { addSpan TStructure }+<0> "end"\ *"structure" / { legacy90P } { addSpan TEndStructure }+<0> "union" / { legacy90P } { addSpan TUnion }+<0> "end"\ *"union" / { legacy90P } { addSpan TEndUnion }+<0> "map" { addSpan TMap }+<0> "end"\ *"map" { addSpan TEndMap }+<0> "automatic" / { legacy90P } { addSpan TAutomatic }+<0> "static" / { legacy90P } { addSpan TStatic } -- Type def related <0,scT> "type" { addSpan TType }@@ -643,6 +651,9 @@ -- Lexer helpers -------------------------------------------------------------------------------- +legacy90P :: User -> AlexInput -> Int -> AlexInput -> Bool+legacy90P (User fv _) _ _ _ = fv == Fortran90Legacy+ adjustComment :: LexAction (Maybe Token) -> LexAction (Maybe Token) adjustComment action = do mTok <- action@@ -1261,6 +1272,14 @@ | TReturn SrcSpan | TEntry SrcSpan | TInclude SrcSpan+ | TStructure SrcSpan+ | TEndStructure SrcSpan+ | TUnion SrcSpan+ | TEndUnion SrcSpan+ | TMap SrcSpan+ | TEndMap SrcSpan+ | TAutomatic SrcSpan+ | TStatic SrcSpan -- language-binding-spec | TBind SrcSpan | TC SrcSpan
src/Language/Fortran/PrettyPrint.hs view
@@ -480,7 +480,7 @@ | otherwise = prettyError "unhandled version" pprint' v (StStructure _ _ mName itemList) =- olderThan Fortran77Legacy "Structure" v $+ continueOnlyFor [Fortran77Legacy, Fortran90Legacy] "Structure" v $ "structure" <+> (if isJust mName then "/" <> pprint' v mName <> "/" else empty) <> newline@@ -545,11 +545,11 @@ | otherwise = "data" <+> hsep (map (pprint' v) dataGroups) pprint' v (StAutomatic _ _ decls) =- continueOnlyFor [Fortran77Extended, Fortran77Legacy] "Automatic statement" v $+ continueOnlyFor [Fortran77Extended, Fortran77Legacy, Fortran90Legacy] "Automatic statement" v $ "automatic" <+> pprint' v decls pprint' v (StStatic _ _ decls) =- continueOnlyFor [Fortran77Extended, Fortran77Legacy] "Static statement" v $+ continueOnlyFor [Fortran77Extended, Fortran77Legacy, Fortran90Legacy] "Static statement" v $ "static" <+> pprint' v decls pprint' v (StNamelist _ _ namelist)
src/Language/Fortran/Util/Files.hs view
@@ -12,7 +12,7 @@ import qualified Data.Text.Encoding.Error as T import qualified Data.ByteString.Char8 as B import System.Directory (listDirectory, canonicalizePath,- doesDirectoryExist, getDirectoryContents)+ doesDirectoryExist, getDirectoryContents, doesFileExist) import System.FilePath ((</>), takeExtension) import System.IO.Temp (withSystemTempDirectory) import System.Process (callProcess)
src/Language/Fortran/Version.hs view
@@ -24,6 +24,7 @@ | Fortran77Extended -- ^ F77 with some extensions | Fortran77Legacy -- ^ F77 with most extensions | Fortran90+ | Fortran90Legacy -- ^ F90 with legacy extensions | Fortran95 | Fortran2003 | Fortran2008@@ -35,6 +36,7 @@ show Fortran77Extended = "Fortran 77 Extended" show Fortran77Legacy = "Fortran 77 Legacy" show Fortran90 = "Fortran 90"+ show Fortran90Legacy = "Fortran 90 Legacy" show Fortran95 = "Fortran 95" show Fortran2003 = "Fortran 2003" show Fortran2008 = "Fortran 2008"@@ -48,6 +50,7 @@ , ("77l", Fortran77Legacy) , ("77" , Fortran77) , ("90" , Fortran90)+ , ("90l", Fortran90Legacy) , ("95" , Fortran95) , ("03" , Fortran2003) , ("08" , Fortran2008) ]
− test-data/module/leaf.mod
binary file changed (215 → absent bytes)
− test-data/pragma.f90
@@ -1,30 +0,0 @@-module foo- implicit none- != unit s :: j- integer :: j-#ifdef PRAGMALAND- use iso_c_binding-#endif- != unit t :: k- integer :: k--!! Example with a CPP ifdef- contains- subroutine main()- integer :: x- x = simple(k) + simple(1)- x = simple(j)- end subroutine- function simple(x) result(i)- integer :: x- integer :: i- i = x * x- ! thest-#ifdef CAM_PROFILE- print *, "Hello from simple"- i = i + 0-#endif- ! thingummy- print *, "Hello from simple"- end function-end module
− test-data/pragma.f90.expected
@@ -1,292 +0,0 @@-ProgramFile {programFileMeta = MetaInfo {miVersion = Fortran90,- miFilename = "test-data/pragma.f90"},- programFileProgramUnits = [PUModule ()- (1:0)-(30:9)- "foo"- [BlStatement ()- (2:2)-(2:14)- Nothing- (StImplicit ()- (2:2)-(2:14)- Nothing),- BlComment ()- (3:2)-(3:15)- (Comment "= unit s :: j"),- BlStatement ()- (4:2)-(4:13)- Nothing- (StDeclaration ()- (4:2)-(4:13)- (TypeSpec- {typeSpecAnno = (),- typeSpecSpan = (4:2)-(4:8),- typeSpecBaseType = TypeInteger,- typeSpecSelector = Nothing})- Nothing- (AList- {alistAnno = (),- alistSpan = (4:13)-(4:13),- alistList = [Declarator {declaratorAnno = (),- declaratorSpan = (4:13)-(4:13),- declaratorVariable = ExpValue ()- (4:13)-(4:13)- (ValVariable "j"),- declaratorType = ScalarDecl,- declaratorLength = Nothing,- declaratorInitial = Nothing}]})),- BlStatement ()- (6:2)-(6:18)- Nothing- (StUse ()- (6:2)-(6:18)- (ExpValue ()- (6:6)-(6:18)- (ValVariable "iso_c_binding"))- Nothing- Permissive- Nothing),- BlComment ()- (8:2)-(8:15)- (Comment "= unit t :: k"),- BlStatement ()- (9:2)-(9:13)- Nothing- (StDeclaration ()- (9:2)-(9:13)- (TypeSpec- {typeSpecAnno = (),- typeSpecSpan = (9:2)-(9:8),- typeSpecBaseType = TypeInteger,- typeSpecSelector = Nothing})- Nothing- (AList- {alistAnno = (),- alistSpan = (9:13)-(9:13),- alistList = [Declarator {declaratorAnno = (),- declaratorSpan = (9:13)-(9:13),- declaratorVariable = ExpValue ()- (9:13)-(9:13)- (ValVariable "k"),- declaratorType = ScalarDecl,- declaratorLength = Nothing,- declaratorInitial = Nothing}]})),- BlComment ()- (11:0)-(11:26)- (Comment "! example with a cpp ifdef")]- (Just [PUSubroutine ()- (13:4)-(17:17)- (Nothing,- Nothing)- "main"- Nothing- [BlStatement ()- (14:6)-(14:17)- Nothing- (StDeclaration ()- (14:6)-(14:17)- (TypeSpec- {typeSpecAnno = (),- typeSpecSpan = (14:6)-(14:12),- typeSpecBaseType = TypeInteger,- typeSpecSelector = Nothing})- Nothing- (AList- {alistAnno = (),- alistSpan = (14:17)-(14:17),- alistList = [Declarator {declaratorAnno = (),- declaratorSpan = (14:17)-(14:17),- declaratorVariable = ExpValue ()- (14:17)-(14:17)- (ValVariable "x"),- declaratorType = ScalarDecl,- declaratorLength = Nothing,- declaratorInitial = Nothing}]})),- BlStatement ()- (15:6)-(15:30)- Nothing- (StExpressionAssign ()- (15:6)-(15:30)- (ExpValue ()- (15:6)-(15:6)- (ValVariable "x"))- (ExpBinary ()- (15:10)-(15:30)- Addition- (ExpFunctionCall ()- (15:10)-(15:18)- (ExpValue ()- (15:10)-(15:15)- (ValVariable "simple"))- (AList- {alistAnno = (),- alistSpan = (15:17)-(15:17),- alistList = [Argument {argumentAnno = (),- argumentSpan = (15:17)-(15:17),- argumentName = Nothing,- argumentExpr = ArgExpr (ExpValue ()- (15:17)-(15:17)- (ValVariable "k"))}]}))- (ExpFunctionCall ()- (15:22)-(15:30)- (ExpValue ()- (15:22)-(15:27)- (ValVariable "simple"))- (AList- {alistAnno = (),- alistSpan = (15:29)-(15:29),- alistList = [Argument {argumentAnno = (),- argumentSpan = (15:29)-(15:29),- argumentName = Nothing,- argumentExpr = ArgExpr (ExpValue ()- (15:29)-(15:29)- (ValInteger "1"- Nothing))}]})))),- BlStatement ()- (16:6)-(16:18)- Nothing- (StExpressionAssign ()- (16:6)-(16:18)- (ExpValue ()- (16:6)-(16:6)- (ValVariable "x"))- (ExpFunctionCall ()- (16:10)-(16:18)- (ExpValue ()- (16:10)-(16:15)- (ValVariable "simple"))- (AList- {alistAnno = (),- alistSpan = (16:17)-(16:17),- alistList = [Argument {argumentAnno = (),- argumentSpan = (16:17)-(16:17),- argumentName = Nothing,- argumentExpr = ArgExpr (ExpValue ()- (16:17)-(16:17)- (ValVariable "j"))}]})))]- Nothing,- PUFunction ()- (18:4)-(29:15)- Nothing- (Nothing,- Nothing)- "simple"- (Just AList {alistAnno = (),- alistSpan = (18:20)-(18:20),- alistList = [ExpValue ()- (18:20)-(18:20)- (ValVariable "x")]})- (Just ExpValue ()- (18:30)-(18:30)- (ValVariable "i"))- [BlStatement ()- (19:8)-(19:19)- Nothing- (StDeclaration ()- (19:8)-(19:19)- (TypeSpec- {typeSpecAnno = (),- typeSpecSpan = (19:8)-(19:14),- typeSpecBaseType = TypeInteger,- typeSpecSelector = Nothing})- Nothing- (AList- {alistAnno = (),- alistSpan = (19:19)-(19:19),- alistList = [Declarator {declaratorAnno = (),- declaratorSpan = (19:19)-(19:19),- declaratorVariable = ExpValue ()- (19:19)-(19:19)- (ValVariable "x"),- declaratorType = ScalarDecl,- declaratorLength = Nothing,- declaratorInitial = Nothing}]})),- BlStatement ()- (20:8)-(20:19)- Nothing- (StDeclaration ()- (20:8)-(20:19)- (TypeSpec- {typeSpecAnno = (),- typeSpecSpan = (20:8)-(20:14),- typeSpecBaseType = TypeInteger,- typeSpecSelector = Nothing})- Nothing- (AList- {alistAnno = (),- alistSpan = (20:19)-(20:19),- alistList = [Declarator {declaratorAnno = (),- declaratorSpan = (20:19)-(20:19),- declaratorVariable = ExpValue ()- (20:19)-(20:19)- (ValVariable "i"),- declaratorType = ScalarDecl,- declaratorLength = Nothing,- declaratorInitial = Nothing}]})),- BlStatement ()- (21:8)-(21:16)- Nothing- (StExpressionAssign ()- (21:8)-(21:16)- (ExpValue ()- (21:8)-(21:8)- (ValVariable "i"))- (ExpBinary ()- (21:12)-(21:16)- Multiplication- (ExpValue ()- (21:12)-(21:12)- (ValVariable "x"))- (ExpValue ()- (21:16)-(21:16)- (ValVariable "x")))),- BlComment ()- (22:8)-(22:14)- (Comment " thest"),- BlStatement ()- (24:8)-(24:35)- Nothing- (StPrint ()- (24:8)-(24:35)- (ExpValue ()- (24:14)-(24:14)- ValStar)- (Just AList {alistAnno = (),- alistSpan = (24:17)-(24:35),- alistList = [ExpValue ()- (24:17)-(24:35)- (ValString "Hello from simple")]})),- BlStatement ()- (25:8)-(25:16)- Nothing- (StExpressionAssign ()- (25:8)-(25:16)- (ExpValue ()- (25:8)-(25:8)- (ValVariable "i"))- (ExpBinary ()- (25:12)-(25:16)- Addition- (ExpValue ()- (25:12)-(25:12)- (ValVariable "i"))- (ExpValue ()- (25:16)-(25:16)- (ValInteger "0"- Nothing)))),- BlComment ()- (27:8)-(27:18)- (Comment " thingummy"),- BlStatement ()- (28:8)-(28:35)- Nothing- (StPrint ()- (28:8)-(28:35)- (ExpValue ()- (28:14)-(28:14)- ValStar)- (Just AList {alistAnno = (),- alistSpan = (28:17)-(28:35),- alistList = [ExpValue ()- (28:17)-(28:35)- (ValString "Hello from simple")]}))]- Nothing])]}
− test-data/small.f90
@@ -1,17 +0,0 @@-module foo- implicit none- ! comment- integer :: i- #ifdef PRAGMALAND- use iso_c_binding-#endif-contains-subroutine main()- integer :: x- x = simple(k) + simple(1)- x = simple(j)-end subroutine-function simple(x) result(i)- integer :: x-end function-end module
− test-data/small.f90.expected
@@ -1,175 +0,0 @@-ProgramFile {programFileMeta = MetaInfo {miVersion = Fortran90,- miFilename = "test-data/small.f90"},- programFileProgramUnits = [PUModule ()- (1:0)-(17:9)- "foo"- [BlStatement ()- (2:2)-(2:14)- Nothing- (StImplicit ()- (2:2)-(2:14)- Nothing),- BlComment ()- (3:2)-(3:10)- (Comment " comment"),- BlStatement ()- (4:2)-(4:13)- Nothing- (StDeclaration ()- (4:2)-(4:13)- (TypeSpec- {typeSpecAnno = (),- typeSpecSpan = (4:2)-(4:8),- typeSpecBaseType = TypeInteger,- typeSpecSelector = Nothing})- Nothing- (AList- {alistAnno = (),- alistSpan = (4:13)-(4:13),- alistList = [Declarator {declaratorAnno = (),- declaratorSpan = (4:13)-(4:13),- declaratorVariable = ExpValue ()- (4:13)-(4:13)- (ValVariable "i"),- declaratorType = ScalarDecl,- declaratorLength = Nothing,- declaratorInitial = Nothing}]})),- BlStatement ()- (6:2)-(6:18)- Nothing- (StUse ()- (6:2)-(6:18)- (ExpValue ()- (6:6)-(6:18)- (ValVariable "iso_c_binding"))- Nothing- Permissive- Nothing)]- (Just [PUSubroutine ()- (9:0)-(13:13)- (Nothing,- Nothing)- "main"- Nothing- [BlStatement ()- (10:2)-(10:13)- Nothing- (StDeclaration ()- (10:2)-(10:13)- (TypeSpec- {typeSpecAnno = (),- typeSpecSpan = (10:2)-(10:8),- typeSpecBaseType = TypeInteger,- typeSpecSelector = Nothing})- Nothing- (AList- {alistAnno = (),- alistSpan = (10:13)-(10:13),- alistList = [Declarator {declaratorAnno = (),- declaratorSpan = (10:13)-(10:13),- declaratorVariable = ExpValue ()- (10:13)-(10:13)- (ValVariable "x"),- declaratorType = ScalarDecl,- declaratorLength = Nothing,- declaratorInitial = Nothing}]})),- BlStatement ()- (11:2)-(11:26)- Nothing- (StExpressionAssign ()- (11:2)-(11:26)- (ExpValue ()- (11:2)-(11:2)- (ValVariable "x"))- (ExpBinary ()- (11:6)-(11:26)- Addition- (ExpFunctionCall ()- (11:6)-(11:14)- (ExpValue ()- (11:6)-(11:11)- (ValVariable "simple"))- (AList- {alistAnno = (),- alistSpan = (11:13)-(11:13),- alistList = [Argument {argumentAnno = (),- argumentSpan = (11:13)-(11:13),- argumentName = Nothing,- argumentExpr = ArgExpr (ExpValue ()- (11:13)-(11:13)- (ValVariable "k"))}]}))- (ExpFunctionCall ()- (11:18)-(11:26)- (ExpValue ()- (11:18)-(11:23)- (ValVariable "simple"))- (AList- {alistAnno = (),- alistSpan = (11:25)-(11:25),- alistList = [Argument {argumentAnno = (),- argumentSpan = (11:25)-(11:25),- argumentName = Nothing,- argumentExpr = ArgExpr (ExpValue ()- (11:25)-(11:25)- (ValInteger "1"- Nothing))}]})))),- BlStatement ()- (12:2)-(12:14)- Nothing- (StExpressionAssign ()- (12:2)-(12:14)- (ExpValue ()- (12:2)-(12:2)- (ValVariable "x"))- (ExpFunctionCall ()- (12:6)-(12:14)- (ExpValue ()- (12:6)-(12:11)- (ValVariable "simple"))- (AList- {alistAnno = (),- alistSpan = (12:13)-(12:13),- alistList = [Argument {argumentAnno = (),- argumentSpan = (12:13)-(12:13),- argumentName = Nothing,- argumentExpr = ArgExpr (ExpValue ()- (12:13)-(12:13)- (ValVariable "j"))}]})))]- Nothing,- PUFunction ()- (14:0)-(16:11)- Nothing- (Nothing,- Nothing)- "simple"- (Just AList {alistAnno = (),- alistSpan = (14:16)-(14:16),- alistList = [ExpValue ()- (14:16)-(14:16)- (ValVariable "x")]})- (Just ExpValue ()- (14:26)-(14:26)- (ValVariable "i"))- [BlStatement ()- (15:2)-(15:13)- Nothing- (StDeclaration ()- (15:2)-(15:13)- (TypeSpec- {typeSpecAnno = (),- typeSpecSpan = (15:2)-(15:8),- typeSpecBaseType = TypeInteger,- typeSpecSelector = Nothing})- Nothing- (AList- {alistAnno = (),- alistSpan = (15:13)-(15:13),- alistList = [Declarator {declaratorAnno = (),- declaratorSpan = (15:13)-(15:13),- declaratorVariable = ExpValue ()- (15:13)-(15:13)- (ValVariable "x"),- declaratorType = ScalarDecl,- declaratorLength = Nothing,- declaratorInitial = Nothing}]}))]- Nothing])]}
− test-data/st.expected
@@ -1,10 +0,0 @@-(StPrint ()- (24:8)-(24:35)- (ExpValue ()- (24:14)-(24:14)- ValStar)- (Just AList {alistAnno = (),- alistSpan = (24:17)-(24:35),- alistList = [ExpValue ()- (24:17)-(24:35)- (ValString "Hello from simple")]}))
− test-data/st2.expected
@@ -1,5 +0,0 @@-TypeSpec- {typeSpecAnno = (),- typeSpecSpan = (4:2)-(4:8),- typeSpecBaseType = TypeInteger,- typeSpecSelector = Nothing}
test/Language/Fortran/Parser/Free/Fortran90Spec.hs view
@@ -17,21 +17,24 @@ --import qualified Data.List as List import qualified Data.ByteString.Char8 as B -parseWith :: Parse Free.AlexInput Free.Token a -> String -> a-parseWith p = parseUnsafe (makeParserFree p Fortran90) . B.pack+parseWith :: FortranVersion -> Parse Free.AlexInput Free.Token a -> String -> a+parseWith v p = parseUnsafe (makeParserFree p v) . B.pack eParser :: String -> Expression () eParser = parseUnsafe p . B.pack where p = makeParser initParseStateFreeExpr F90.expressionParser Fortran90 sParser :: String -> Statement ()-sParser = parseWith F90.statementParser+sParser = parseWith Fortran90 F90.statementParser +slParser :: String -> Statement ()+slParser = parseWith Fortran90Legacy F90.statementParser+ bParser :: String -> Block ()-bParser = parseWith F90.blockParser+bParser = parseWith Fortran90 F90.blockParser fParser :: String -> ProgramUnit ()-fParser = parseWith F90.functionParser+fParser = parseWith Fortran90 F90.functionParser {- Useful for parser debugging; Lexes the given source code. fTok :: String -> [Token]@@ -484,3 +487,83 @@ sParser "use stats_lib, only: a, b => c, operator(+), assignment(=)" `shouldBe'` st specFreeCommon bParser sParser eParser++ describe "Legacy Extensions" $ do+ it "parses automatic and static statements" $ do+ let decl = declVariable () u (varGen "x") Nothing Nothing+ autoStmt = StAutomatic () u (AList () u [decl])+ staticStmt = StStatic () u (AList () u [decl])+ autoSrc = "automatic x"+ staticSrc = "static x"+ resetSrcSpan (slParser autoSrc) `shouldBe` autoStmt+ resetSrcSpan (slParser staticSrc) `shouldBe` staticStmt++ it "parses structure/union/map blocks" $ do+ let src = init+ $ unlines [ "structure /foo/"+ , " union"+ , " map"+ , " integer i"+ , " end map"+ , " map"+ , " real r"+ , " end map"+ , " end union"+ , "end structure"]+ ds = [ UnionMap () u $ AList () u+ [StructFields () u (TypeSpec () u TypeInteger Nothing) Nothing $+ AList () u [declVariable () u (varGen "i") Nothing Nothing]]+ , UnionMap () u $ AList () u+ [StructFields () u (TypeSpec () u TypeReal Nothing) Nothing $+ AList () u [declVariable () u (varGen "r") Nothing Nothing]]+ ]+ st = StStructure () u (Just "foo") $ AList () u [StructUnion () u $ AList () u ds]+ resetSrcSpan (slParser src) `shouldBe` st++ it "parses structure/union/map blocks with comments" $ do+ let src = init+ $ unlines [ "structure /foo/"+ , "! comment before union"+ , " union"+ , "! comment inside union, before map"+ , " map"+ , "! comment inside map"+ , " integer i"+ , " end map"+ , "! comment between maps"+ , " map"+ , " real r"+ , " end map"+ , "! comment after map"+ , " end union"+ , "! comment after union"+ , "end structure"]+ ds = [ UnionMap () u $ AList () u+ [StructFields () u (TypeSpec () u TypeInteger Nothing) Nothing $+ AList () u [declVariable () u (varGen "i") Nothing Nothing]]+ , UnionMap () u $ AList () u+ [StructFields () u (TypeSpec () u TypeReal Nothing) Nothing $+ AList () u [declVariable () u (varGen "r") Nothing Nothing]]+ ]+ st = StStructure () u (Just "foo") $ AList () u [StructUnion () u $ AList () u ds]+ resetSrcSpan (slParser src) `shouldBe` st++ it "parses nested structure blocks" $ do+ let src = init+ $ unlines [ "structure /foo/"+ , " structure /bar/ baz"+ , " integer qux"+ , " end structure"+ , "end structure"]+ var = declVariable () u (varGen "qux") Nothing Nothing+ innerst = StructStructure () u (Just "bar") "baz"+ $ AList () u [StructFields () u (TypeSpec () u TypeInteger Nothing) Nothing+ $ AList () u [var]]+ st = StStructure () u (Just "foo") $ AList () u [innerst]+ resetSrcSpan (slParser src) `shouldBe` st++ it "parses structure data references" $ do+ let st = StPrint () u expStar $ Just $ AList () u [foobar]+ foobar = ExpDataRef () u (varGen "foo") (varGen "bar")+ expStar = ExpValue () u ValStar+ sParser "print *, foo % bar" `shouldBe'` st