fortran-vars 0.1.0 → 0.3.0
raw patch · 18 files changed
+244/−528 lines, 18 filesdep ~fortran-srcPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: fortran-src
API changes (from Hackage documentation)
- Language.Fortran.Vars.BozConstant: instance GHC.Show.Show Language.Fortran.Vars.BozConstant.BozDecomposed
+ Language.Fortran.Vars.Types: instance Data.Aeson.Types.FromJSON.FromJSON Language.Fortran.AST.Boz.Boz
+ Language.Fortran.Vars.Types: instance Data.Aeson.Types.FromJSON.FromJSON Language.Fortran.AST.Boz.BozPrefix
+ Language.Fortran.Vars.Types: instance Data.Aeson.Types.ToJSON.ToJSON Language.Fortran.AST.Boz.Boz
+ Language.Fortran.Vars.Types: instance Data.Aeson.Types.ToJSON.ToJSON Language.Fortran.AST.Boz.BozPrefix
- Language.Fortran.Vars.Types: Boz :: String -> ExpVal
+ Language.Fortran.Vars.Types: Boz :: Boz -> ExpVal
Files
- CHANGELOG.md +13/−0
- LICENSE +10/−199
- README.md +28/−2
- fortran-vars.cabal +4/−4
- src/Language/Fortran/Vars/Assignments.hs +4/−3
- src/Language/Fortran/Vars/BozConstant.hs +19/−73
- src/Language/Fortran/Vars/Memory.hs +8/−6
- src/Language/Fortran/Vars/Operation.hs +8/−43
- src/Language/Fortran/Vars/StorageClass.hs +1/−3
- src/Language/Fortran/Vars/StructureTable.hs +5/−4
- src/Language/Fortran/Vars/SymbolTable.hs +80/−140
- src/Language/Fortran/Vars/TypeCheck.hs +22/−7
- src/Language/Fortran/Vars/Types.hs +6/−1
- test/AssignmentsSpec.hs +1/−1
- test/BozConstantSpec.hs +31/−28
- test/EvalSpec.hs +3/−3
- test/StructureTableSpec.hs +0/−8
- test/SymbolTableSpec.hs +1/−3
CHANGELOG.md view
@@ -1,3 +1,16 @@+## 0.3.0 (10 Jan 2021)+ * Update to fortran-src 0.8.0+ * Replace BozDecomposed with new Boz type in fortran-src+ * Due to how the BozConstant module was used, this should have minimal+ impact. Code that reads and writes BOZs into `ExpVal`s directly may need+ updating.++## 0.2.0 (24 Nov 2021)+ * Update to fortran-src 0.6.0+ * Gather type info from COMMON blocks better (as they now support dimension+ declarators) #1+ * Fix some disabled tests #1+ ## 0.1.0 (6 Sep 2021) Initial release.
LICENSE view
@@ -1,202 +1,13 @@-- Apache License- Version 2.0, January 2004- http://www.apache.org/licenses/-- TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION-- 1. Definitions.-- "License" shall mean the terms and conditions for use, reproduction,- and distribution as defined by Sections 1 through 9 of this document.-- "Licensor" shall mean the copyright owner or entity authorized by- the copyright owner that is granting the License.-- "Legal Entity" shall mean the union of the acting entity and all- other entities that control, are controlled by, or are under common- control with that entity. For the purposes of this definition,- "control" means (i) the power, direct or indirect, to cause the- direction or management of such entity, whether by contract or- otherwise, or (ii) ownership of fifty percent (50%) or more of the- outstanding shares, or (iii) beneficial ownership of such entity.-- "You" (or "Your") shall mean an individual or Legal Entity- exercising permissions granted by this License.-- "Source" form shall mean the preferred form for making modifications,- including but not limited to software source code, documentation- source, and configuration files.-- "Object" form shall mean any form resulting from mechanical- transformation or translation of a Source form, including but- not limited to compiled object code, generated documentation,- and conversions to other media types.-- "Work" shall mean the work of authorship, whether in Source or- Object form, made available under the License, as indicated by a- copyright notice that is included in or attached to the work- (an example is provided in the Appendix below).-- "Derivative Works" shall mean any work, whether in Source or Object- form, that is based on (or derived from) the Work and for which the- editorial revisions, annotations, elaborations, or other modifications- represent, as a whole, an original work of authorship. For the purposes- of this License, Derivative Works shall not include works that remain- separable from, or merely link (or bind by name) to the interfaces of,- the Work and Derivative Works thereof.-- "Contribution" shall mean any work of authorship, including- the original version of the Work and any modifications or additions- to that Work or Derivative Works thereof, that is intentionally- submitted to Licensor for inclusion in the Work by the copyright owner- or by an individual or Legal Entity authorized to submit on behalf of- the copyright owner. For the purposes of this definition, "submitted"- means any form of electronic, verbal, or written communication sent- to the Licensor or its representatives, including but not limited to- communication on electronic mailing lists, source code control systems,- and issue tracking systems that are managed by, or on behalf of, the- Licensor for the purpose of discussing and improving the Work, but- excluding communication that is conspicuously marked or otherwise- designated in writing by the copyright owner as "Not a Contribution."-- "Contributor" shall mean Licensor and any individual or Legal Entity- on behalf of whom a Contribution has been received by Licensor and- subsequently incorporated within the Work.-- 2. Grant of Copyright License. Subject to the terms and conditions of- this License, each Contributor hereby grants to You a perpetual,- worldwide, non-exclusive, no-charge, royalty-free, irrevocable- copyright license to reproduce, prepare Derivative Works of,- publicly display, publicly perform, sublicense, and distribute the- Work and such Derivative Works in Source or Object form.-- 3. Grant of Patent License. Subject to the terms and conditions of- this License, each Contributor hereby grants to You a perpetual,- worldwide, non-exclusive, no-charge, royalty-free, irrevocable- (except as stated in this section) patent license to make, have made,- use, offer to sell, sell, import, and otherwise transfer the Work,- where such license applies only to those patent claims licensable- by such Contributor that are necessarily infringed by their- Contribution(s) alone or by combination of their Contribution(s)- with the Work to which such Contribution(s) was submitted. If You- institute patent litigation against any entity (including a- cross-claim or counterclaim in a lawsuit) alleging that the Work- or a Contribution incorporated within the Work constitutes direct- or contributory patent infringement, then any patent licenses- granted to You under this License for that Work shall terminate- as of the date such litigation is filed.-- 4. Redistribution. You may reproduce and distribute copies of the- Work or Derivative Works thereof in any medium, with or without- modifications, and in Source or Object form, provided that You- meet the following conditions:-- (a) You must give any other recipients of the Work or- Derivative Works a copy of this License; and-- (b) You must cause any modified files to carry prominent notices- stating that You changed the files; and-- (c) You must retain, in the Source form of any Derivative Works- that You distribute, all copyright, patent, trademark, and- attribution notices from the Source form of the Work,- excluding those notices that do not pertain to any part of- the Derivative Works; and-- (d) If the Work includes a "NOTICE" text file as part of its- distribution, then any Derivative Works that You distribute must- include a readable copy of the attribution notices contained- within such NOTICE file, excluding those notices that do not- pertain to any part of the Derivative Works, in at least one- of the following places: within a NOTICE text file distributed- as part of the Derivative Works; within the Source form or- documentation, if provided along with the Derivative Works; or,- within a display generated by the Derivative Works, if and- wherever such third-party notices normally appear. The contents- of the NOTICE file are for informational purposes only and- do not modify the License. You may add Your own attribution- notices within Derivative Works that You distribute, alongside- or as an addendum to the NOTICE text from the Work, provided- that such additional attribution notices cannot be construed- as modifying the License.-- You may add Your own copyright statement to Your modifications and- may provide additional or different license terms and conditions- for use, reproduction, or distribution of Your modifications, or- for any such Derivative Works as a whole, provided Your use,- reproduction, and distribution of the Work otherwise complies with- the conditions stated in this License.-- 5. Submission of Contributions. Unless You explicitly state otherwise,- any Contribution intentionally submitted for inclusion in the Work- by You to the Licensor shall be under the terms and conditions of- this License, without any additional terms or conditions.- Notwithstanding the above, nothing herein shall supersede or modify- the terms of any separate license agreement you may have executed- with Licensor regarding such Contributions.-- 6. Trademarks. This License does not grant permission to use the trade- names, trademarks, service marks, or product names of the Licensor,- except as required for reasonable and customary use in describing the- origin of the Work and reproducing the content of the NOTICE file.-- 7. Disclaimer of Warranty. Unless required by applicable law or- agreed to in writing, Licensor provides the Work (and each- Contributor provides its Contributions) on an "AS IS" BASIS,- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or- implied, including, without limitation, any warranties or conditions- of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A- PARTICULAR PURPOSE. You are solely responsible for determining the- appropriateness of using or redistributing the Work and assume any- risks associated with Your exercise of permissions under this License.-- 8. Limitation of Liability. In no event and under no legal theory,- whether in tort (including negligence), contract, or otherwise,- unless required by applicable law (such as deliberate and grossly- negligent acts) or agreed to in writing, shall any Contributor be- liable to You for damages, including any direct, indirect, special,- incidental, or consequential damages of any character arising as a- result of this License or out of the use or inability to use the- Work (including but not limited to damages for loss of goodwill,- work stoppage, computer failure or malfunction, or any and all- other commercial damages or losses), even if such Contributor- has been advised of the possibility of such damages.-- 9. Accepting Warranty or Additional Liability. While redistributing- the Work or Derivative Works thereof, You may choose to offer,- and charge a fee for, acceptance of support, warranty, indemnity,- or other liability obligations and/or rights consistent with this- License. However, in accepting such obligations, You may act only- on Your own behalf and on Your sole responsibility, not on behalf- of any other Contributor, and only if You agree to indemnify,- defend, and hold each Contributor harmless for any liability- incurred by, or claims asserted against, such Contributor by reason- of your accepting any such warranty or additional liability.-- END OF TERMS AND CONDITIONS-- APPENDIX: How to apply the Apache License to your work.-- To apply the Apache License to your work, attach the following- boilerplate notice, with the fields enclosed by brackets "[]"- replaced with your own identifying information. (Don't include- the brackets!) The text should be enclosed in the appropriate- comment syntax for the file format. We also recommend that a- file or class name and description of purpose be included on the- same "printed page" as the copyright notice for easier- identification within third-party archives.-- Copyright 2019 Bloomberg Finance L.P.+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+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+ 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.+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.
README.md view
@@ -1,5 +1,4 @@ # fortran-vars- `fortran-vars` is a static analysis library for Fortran code. It is built on top of the open source project [`fortran-src`](https://github.com/camfort/fortran-src) which provides lexing, parsing and basic analyses of Fortran code. `fortran-vars` focuses on supporting the Fortran 77 standard and extensions. It provides a Fortran memory model with a symbol table and storage table, constant expressions evaluation, constant propagation analysis ## Fortran Memory Model@@ -42,7 +41,7 @@ command-line tool that dumps the symbol table and storage table of the input program in JSON format. ```- fortran-vars (-v|--fortranVersion VERSION) [-I|--include DIRECTORY] FILE+fortran-vars (-v|--fortranVersion VERSION) [-I|--include DIRECTORY] FILE ``` ## Build@@ -52,3 +51,30 @@ stack build stack test ```++Alternatively, you can use Cabal:++```+cabal build+cabal test+```++## Contributors+Thanks to the original package authors:++ * Aiden Jeffrey <ajeffrey15@bloomberg.net>+ * Anthony Burzillo <aburzillo@bloomberg.net>+ * Azeem Bande-ali <abandeali@bloomberg.net>+ * Benjamin Groh <bgroh2@bloomberg.net>+ * Chris Cotter <ccotter14@bloomberg.net>+ * Daniel Beer <dbeer1@bloomberg.net>+ * Darius Makovsky <bapophis@bloomberg.net>+ * Eric Schneider <eschneider47@bloomberg.net>+ * Eric Seidel <eseidel13@bloomberg.net>+ * Jason Xu <jxu116@bloomberg.net>+ * Kojo Adams <kadams85@bloomberg.net>+ * Lukasz Kolodziejczyk <lkolodziejc1@bloomberg.net>+ * Mario Longobardi <mlongobardi2@bloomberg.net>+ * Poppy Singleton-Hoare <psingletonho@bloomberg.net>+ * Raoul Hidalgo Charman <rhidalgochar@bloomberg.net>+ * Ti Liang <tliang54@bloomberg.net>
fortran-vars.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: fortran-vars-version: 0.1.0+version: 0.3.0 synopsis: Fortran memory model and other static analysis tools. description: Various Fortran static analysis tools focusing on a memory model for Fortran types. Uses fortran-src for the syntax representation. category: Language@@ -60,7 +60,7 @@ , containers >=0.5.7.1 , deepseq >=1.4.4.0 , fgl >=5- , fortran-src >=0.5.0 && <0.6.0+ , fortran-src >=0.8.0 && <0.9 , fortran-src-extras >=0.2.0 , text >=1.2.2.2 , uniplate >=1.6.10@@ -80,7 +80,7 @@ , containers >=0.5.7.1 , deepseq >=1.4.4.0 , fgl >=5- , fortran-src >=0.5.0 && <0.6.0+ , fortran-src >=0.8.0 && <0.9 , fortran-src-extras >=0.2.0 , fortran-vars , text >=1.2.2.2@@ -114,7 +114,7 @@ , containers >=0.5.7.1 , deepseq >=1.4.4.0 , fgl >=5- , fortran-src >=0.5.0 && <0.6.0+ , fortran-src >=0.8.0 && <0.9 , fortran-src-extras >=0.2.0 , fortran-vars , hspec
src/Language/Fortran/Vars/Assignments.hs view
@@ -17,6 +17,7 @@ , DataGroup(..) , Expression(..) , Declarator(..)+ , DeclaratorType(..) , Value(..) , aStrip )@@ -62,7 +63,7 @@ ] <> [ (, e) <$> ty | StParameter _ _ decls <- universeBi pu :: [Statement (Analysis a)]- , DeclVariable _ _ v _ (Just e) <- aStrip decls+ , Declarator _ _ v ScalarDecl _ (Just e) <- aStrip decls , let ty = typeOf strt symt v ] <> [ res@@ -98,8 +99,8 @@ -> [Declarator (Analysis a)] -> [Either TypeError (Type, Expression (Analysis a))] declarators strt symt = concatMap f where- f (DeclVariable _ _ v _ (Just e)) = pure $ (, e) <$> typeOf strt symt v- f d@(DeclArray _ _ (ExpValue _ s (ValVariable v)) _ _ (Just (ExpInitialisation _ _ vals)))+ f (Declarator _ _ v ScalarDecl _ (Just e)) = pure $ (, e) <$> typeOf strt symt v+ f d@(Declarator _ _ (ExpValue _ s (ValVariable v)) ArrayDecl{} _ (Just (ExpInitialisation _ _ vals))) = case M.lookup v symt of Just (SVariable (TArray ty (Just dims)) _) -> let tys = expandDimensions dims ty
src/Language/Fortran/Vars/BozConstant.hs view
@@ -11,14 +11,14 @@ , intToDigit , toLower )-import qualified Data.Map as M+import qualified Data.Map as M import Numeric ( readInt , showIntAtBase ) import Text.Read ( ReadS ) -import Language.Fortran.Vars.Types- ( SymbolTableEntry(..)+import qualified Language.Fortran.AST.Boz as AST+import Language.Fortran.Vars.Types ( SymbolTableEntry(..) , Type(..) , SemType(..) , Kind@@ -26,45 +26,23 @@ , SymbolTable ) --- | BozDecomposed is constructed with:--- - String that represents the BOZ constant as it is in code, e.g. "'1111'x"--- - String that represents digits without number system and lowercased, i.e. "ff1e" in "'Ff1E'x"--- - Char that represents number system, i.e. 'x' in "'1111'x"--- - Integer that represents number system, i.e. 16 in "'1111'x"--- - String that represents binary translation of BOZ constant as it is.--- It doesn't take into account any truncations nor overflows-data BozDecomposed = BozDecomposed String String Char Int String- deriving Show--parseBozDecomposed :: ExpVal -> BozDecomposed-parseBozDecomposed (Boz bozStr) = BozDecomposed bozStr- digits- numsysChar- numsysInt- binary- where- digits = getDigits bozStr- numsysChar = if head bozStr `elem` "boxz" then head bozStr else last bozStr- numsysInt = case numsysChar of- 'b' -> 2- 'o' -> 8- 'x' -> 16- 'z' -> 16- _ -> error- (numsysChar- : " is not supported BOZ specifier.\- \ Invalid fortran syntax"- )- binary = toBinaryString digits numsysInt-parseBozDecomposed _ = error "ExpVal is not a BOZ constant"+-- | Given 'SymbolTable', contextual symbol name and BOZ Constant+-- ('ExpVal' constructed with Boz String), resolve BOZ Constant considering+-- contextual symbol.+--+-- Currently, it only resolves BOZ Constants in context of INTEGER.+resolveBozConstant :: SymbolTable -> String -> ExpVal -> ExpVal+resolveBozConstant symTable assignSymbol (Boz boz) =+ resolveBozConstant' symTable assignSymbol boz+resolveBozConstant _ _ _ = error "Can only resolve ExpVal Boz" -resolveBozConstant' :: SymbolTable -> String -> BozDecomposed -> ExpVal-resolveBozConstant' symTable assignSymbol bozDecomposed =+resolveBozConstant' :: SymbolTable -> String -> AST.Boz -> ExpVal+resolveBozConstant' symTable assignSymbol boz = let entry = M.lookup assignSymbol symTable in case entry of Just (SVariable (TInteger kind) _) ->- resolveBozConstantInContext bozDecomposed kind+ resolveBozConstantInContext boz kind Just (SVariable ty _) -> error $ assignSymbol@@ -82,50 +60,18 @@ \Invalid fortran syntax" ) -resolveBozConstantInContext :: BozDecomposed -> Kind -> ExpVal-resolveBozConstantInContext (BozDecomposed _ _ _ _ binary) kind =+resolveBozConstantInContext :: AST.Boz -> Kind -> ExpVal+resolveBozConstantInContext boz kind = let allowedBinaryLength = kind * 8 maxBinaryValue = 2 ^ (allowedBinaryLength - 1) - 1 minBinaryValue = (-1) * 2 ^ (allowedBinaryLength - 1)- truncatedBinary = reverse . take allowedBinaryLength . reverse $ binary- decimal = numsysStringToDecimal truncatedBinary 2+ decimal = AST.bozAsNatural boz overflow = decimal - maxBinaryValue in if overflow > 0 then Int (minBinaryValue + overflow - 1) else Int decimal -getDigits :: String -> String-getDigits bozStr = [ toLower c | c <- digits ]- where- digits =- foldr (\l acc -> if l `elem` "'boxz" then acc else l : acc) [] bozStr--toBinaryString :: String -> Int -> String-toBinaryString digits fromNumsys = decimalToBinaryString decimal- where decimal = numsysStringToDecimal digits fromNumsys--numsysStringToDecimal :: String -> Int -> Int-numsysStringToDecimal digits numsys = decimal- where- numsysValidFunction = (`elem` map intToDigit [0 .. (numsys - 1)])- numsysReader = readInt numsys numsysValidFunction digitToInt :: ReadS Int- ((decimal, _) : _) = numsysReader digits--decimalToBinaryString :: Int -> String-decimalToBinaryString decimal = showIntAtBase 2 intToDigit decimal ""---- | Given 'SymbolTable', contextual symbol name and BOZ Constant--- ('ExpVal' constructed with Boz String), resolve BOZ Constant considering--- contextual symbol.------ Currently, it only resolves BOZ Constants in context of INTEGER.-resolveBozConstant :: SymbolTable -> String -> ExpVal -> ExpVal-resolveBozConstant symTable assignSymbol boz@(Boz _) =- resolveBozConstant' symTable assignSymbol (parseBozDecomposed boz)-resolveBozConstant _ _ _ = error "Can only resolve ExpVal Boz"-- -- Convert BOZ string to integer of specific kind bozToInt :: Int -> ExpVal -> ExpVal-bozToInt kind boz = resolveBozConstantInContext (parseBozDecomposed boz) kind+bozToInt kind (Boz boz) = resolveBozConstantInContext boz kind -- Convert BOZ string to integer*2 bozToInt2 :: ExpVal -> ExpVal
src/Language/Fortran/Vars/Memory.hs view
@@ -22,6 +22,7 @@ , Name , ProgramUnit , Statement(..)+ , Declarator(..) ) import Language.Fortran.Vars.MemoryLocation@@ -97,16 +98,16 @@ processCommon pu puModel = let commonGrps = [ commGrps | (StCommon _ _ (AList _ _ commGrps)) <- allPUS pu ]- mergeCommonVariables mapping (CommonGroup _ _ commName varList) =+ mergeCommonVariables mapping (CommonGroup _ _ commName decls) = let commonName = case commName of Just e -> "/" ++ srcName e ++ "/" Nothing -> "*blank_common*"- vars = aStrip varList- precedingVars = fromMaybe [] (M.lookup commonName mapping)- in M.insert commonName (precedingVars ++ vars) mapping+ precedingDecls = fromMaybe [] (M.lookup commonName mapping)+ in M.insert commonName (precedingDecls ++ aStrip decls) mapping commons = foldl' mergeCommonVariables M.empty (concat commonGrps)- processComm commonName varExps (symTable, mbs) =- let varLocations = map (getStartLocation symTable) varExps+ processComm commonName varDecls (symTable, mbs) =+ let varExps = map declExpr varDecls+ varLocations = map (getStartLocation symTable) varExps varSizes = map (getSize symTable) varExps varAccumSizes = scanl1 (+) varSizes commBlockLocations = map (commonName, ) (0 : varAccumSizes)@@ -120,4 +121,5 @@ in M.insert commonName newBlock mbs f model (l1, l2) = let (model', _) = union model l1 l2 in model' in foldl' f (symTable, mbs') (zip commBlockLocations varLocations)+ declExpr (Declarator _ _ e _ _ _) = e in M.foldrWithKey processComm puModel commons
src/Language/Fortran/Vars/Operation.hs view
@@ -27,6 +27,8 @@ , UnaryOp(..) , Value(..) )+import Language.Fortran.AST.RealLit ( readRealLit )+import Language.Fortran.AST.Boz ( prettyBoz ) import Language.Fortran.Util.Position ( SrcSpan ) @@ -43,40 +45,6 @@ , complement ) --- | Given a 'SrcSpan' and the 'String' string at that span,--- return either a string describing the error encountered, or--- the double held by that string.-readReal :: SrcSpan -> String -> Either String Double-readReal s r =- let r' = transform r- in maybe- (Left $ "Expected a real value at " ++ show s ++ " got '" ++ r' ++ "'"- )- Right- $ readMaybe r'- where- uniformPrecision 'D' = 'E'- uniformPrecision 'Q' = 'E'- uniformPrecision c = c- transform' [] = []- transform' ['.' ] = []- transform' ('.' : y : ys) = case uniformPrecision (toUpper y) of- 'E' -> 'E' : transform' ys- _ -> '.' : y : transform' ys- transform' (x : xs) = uniformPrecision (toUpper x) : transform' xs- transform xs@('.' : _) = transform' $ '0' : xs- transform xs = transform' xs----- | Given a 'String', return either a 'String' describing the--- issue that prevented the read or the 'Bool' value contained--- in the string-readLogical :: String -> Either String Bool-readLogical s = case map toUpper s of- ".TRUE." -> Right True- ".FALSE." -> Right False- _ -> invalidArg' "readLogical" [s]- -- | Given a function that returns an 'Either' and an 'Either' with -- the 'Right' case as the same type input to the function, return -- an either by possibly applying the function to the 'Right' value or@@ -118,15 +86,12 @@ -- by that 'Value'. valueToExpVal' :: SrcSpan -> Value a -> Either String ExpVal valueToExpVal' s val = case val of- ValInteger i ->- let i' = readMaybe i :: Maybe Int- in case i' of- Just valInt -> Right $ Int valInt- Nothing -> Right $ Boz i- ValReal r -> transformEither (Right . Real) $ readReal s r- ValString s' -> Right $ Str s'- ValLogical l -> transformEither (Right . Logical) $ readLogical l- ValHollerith h -> Right $ Str h+ ValInteger i _ -> Right $ Int $ read i+ ValReal r _ -> Right $ Real $ readRealLit r+ ValLogical l _ -> Right $ Logical l+ ValString s' -> Right $ Str s'+ ValHollerith h -> Right $ Str h+ ValBoz b -> Right $ Boz b _ -> Left ("toExpVal: unsupported value at " ++ show s) -- | Given a 'SrcSpan' and the 'Value' returnthe 'ExpVal' held
src/Language/Fortran/Vars/StorageClass.hs view
@@ -30,9 +30,7 @@ puModel (aStrip decls) where- f m (DeclVariable _ _ varExp _ _) =- updateStorageClass (srcName varExp) Automatic m- f m (DeclArray _ _ varExp _ _ _) =+ f m (Declarator _ _ varExp _ _ _) = updateStorageClass (srcName varExp) Automatic m storageClassStmt puModel (StSave _ _ (Just exps)) = foldl' f puModel
src/Language/Fortran/Vars/StructureTable.hs view
@@ -27,6 +27,7 @@ , ProgramFile , TypeSpec(..) , Declarator(..)+ , DeclaratorType(..) , aStrip ) import Language.Fortran.Extras@@ -61,17 +62,17 @@ itemToEntry _ StructStructure{} = [] -- TODO take into account length, should override default typespecs--- | Given the `TypeSpec` and `Declerator` found in a field entry create a--- `StructureTableEntry`+-- | Given the 'TypeSpec' and 'Declarator' found in a field entry create a+-- 'StructureTableEntry' handleDeclarator :: SymbolTable -> TypeSpec (Analysis a) -> Declarator (Analysis a) -> Maybe StructureTableEntry-handleDeclarator st ty (DeclVariable _ _ expr _ _) =+handleDeclarator st ty (Declarator _ _ expr ScalarDecl _ _) = let scalarTy = typeSpecToScalarType st ty in expToName expr >>= \name -> Just $ FieldEntry name scalarTy-handleDeclarator st ty (DeclArray _ _ expr dims _ _) =+handleDeclarator st ty (Declarator _ _ expr (ArrayDecl dims) _ _) = let arrayty = typeSpecToArrayType st (aStrip dims) ty in expToName expr >>= \name -> Just $ FieldEntry name arrayty
src/Language/Fortran/Vars/SymbolTable.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE LambdaCase #-}+ module Language.Fortran.Vars.SymbolTable ( collectSymbols )@@ -8,6 +10,8 @@ ) import Data.List ( foldl' ) import qualified Data.Map as M+import Data.Maybe ( catMaybes )+ import Language.Fortran.Analysis ( Analysis , srcName )@@ -18,6 +22,7 @@ , Block(..) , CommonGroup(..) , Declarator(..)+ , DeclaratorType(..) , DimensionDeclarator(..) , Expression(..) , Index(..)@@ -79,30 +84,6 @@ _ -> Nothing valueOf Nothing = Just 1 --- | Given a 'SymbolTable' and an 'Index', return a pair of--- resolved 'DynamicDimensionElement's representing lower- and upper- bound-resolveDimensionExpSubscript- :: SymbolTable -> Index (Analysis a) -> Maybe (Int, Int)-resolveDimensionExpSubscript symTable index = case index of- IxSingle _ _ _ upperbound -> do- ub <- valueOf upperbound- pure (1, ub)- IxRange _ _ lowerbound upperbound _ -> do- lb <- lowerbound >>= valueOf- ub <- upperbound >>= valueOf- pure (lb, ub)- where- valueOf expr = case eval' symTable expr of- Right (Int i) -> Just i- _ -> Nothing---- | Given a 'SymbolTable' and an 'Argument', return a maybe pair of Ints--- representing lower- and upper- bound-resolveDimensionExpFunctionCall- :: SymbolTable -> Argument (Analysis a) -> Maybe (Int, Int)-resolveDimensionExpFunctionCall symTable (Argument _ _ _ upperbound) =- let ub = toInt (eval symTable upperbound) in Just (1, ub)- -- Parameter declarations -- A parameter may or may not have a type declaration. If it does have one, -- the declaration statement can go before or after the parameter statement.@@ -110,7 +91,7 @@ :: Data a => SymbolTable -> AList Declarator (Analysis a) -> SymbolTable handleParameter symTable alist = foldl' f symTable (aStrip alist) where- f symt (DeclVariable _ _ varExp _ (Just valExp)) =+ f symt (Declarator _ _ varExp ScalarDecl _ (Just valExp)) = let symbol = srcName varExp val' = case eval symt valExp of boz@(Boz _) -> resolveBozConstant symTable symbol boz@@ -165,7 +146,7 @@ Nothing -> SVariable (TCharacter CharLenStar 1) (symbol, 0) in M.insert symbol entry symt -- don't care initial value at this moment- f symt (DeclVariable _ s varExp charLength _) =+ f symt (Declarator _ s varExp ScalarDecl charLength _) = let symbol = srcName varExp ty' = baseToType bt@@ -210,7 +191,7 @@ Nothing -> SVariable ty'' (symbol, 0) in M.insert symbol entry symt- f symt (DeclArray _ _ varExp dimDecls charLength _) =+ f symt (Declarator _ _ varExp (ArrayDecl dimDecls) charLength _) = let symbol = srcName varExp entry = case charLength of@@ -227,18 +208,80 @@ in M.insert symbol entry symt -updateDimensionDimensionDeclarator+-- | Handle an array 'Declarator'.+--+-- 'Declarator's are the RHS of a declaration statement, and also used in COMMON+-- block definitions. They store the variable name, and array type info.+-- Importantly, they don't store any scalar info (only bring the variable into+-- scope). So we only handle array 'Declarator's.+--+-- If the array 'Declarator' is for a variable not (yet) in the given+-- 'SymbolTable', it's given a placeholder scalar type. This is apparently+-- inconsistent with how DIMENSION statements are handled, where such cases are+-- skipped.+handleArrayDecl+ :: Data a+ => SymbolTable -> Expression (Analysis a) -> [DimensionDeclarator (Analysis a)]+ -> SymbolTable+handleArrayDecl symTable varExp dimDecls =+ let symbol = srcName varExp+ dims = traverse (resolveDimensionDimensionDeclarator symTable) dimDecls+ in case M.lookup symbol symTable of+ Just (SVariable TArray{} _) -> error "invalid declarator: duplicate array declarations"+ Just (SVariable ty loc) ->+ let ste = SVariable (TArray ty dims) loc+ in M.insert symbol ste symTable+ Nothing -> -- add array info, use a placeholder for scalar type+ let ste = SVariable (TArray placeholderIntrinsicType dims) (symbol, 0)+ in M.insert symbol ste symTable+ where placeholderIntrinsicType = TInteger 4++-- | Given a 'SymbolTable' and a 'Statement' found in a 'ProgramUnit', return a new 'SymbolTable'+-- with any newly defined symbols+stSymbols :: Data a => SymbolTable -> Statement (Analysis a) -> SymbolTable+stSymbols symTable = \case+ StParameter _ _ alist -> handleParameter symTable alist+ StDeclaration _ _ ts _ decls -> handleDeclaration symTable ts decls+ StDimension _ _ decls -> foldl' handleDimension symTable (aStrip decls)+ StCommon _ _ cmns -> foldl' handleCommon symTable (aStrip cmns)+ StInclude _ _ _ (Just bls) -> foldl' blSymbols symTable bls+ _ -> symTable+ where+ handleDimension symt = \case+ Declarator _ _ varExp (ArrayDecl dimDecls) _ _ ->+ upgradeScalarToArray (srcName varExp) dimDecls symt+ -- DIMENSION statements only permit array declarators, so this is impossible+ -- in a correct parser.+ Declarator _ _ _ ScalarDecl _ _ ->+ error "non-array declaration in a DIMENSION statement"+ handleCommon symt (CommonGroup _ _ mName decls) =+ let arrayDecls = catMaybes . map extractArrayDecl . aStrip $ decls+ in foldl' (uncurry . handleArrayDecl) symt arrayDecls+ extractArrayDecl = \case+ Declarator _ _ v (ArrayDecl d) _ _ -> Just (v, aStrip d)+ Declarator _ _ _ ScalarDecl _ _ -> Nothing++-- | Try to upgrade an existing scalar variable to an array variable.+--+-- Returns the unchanged 'SymbolTable' if the variable didn't exist. If the+-- variable was already an array type, runtime error.+--+-- The DIMENSION statement defines array metadata for a variable. Due to+-- Fortran syntax, a variable's the full type isn't known until the executable+-- statements begin, and you may define array and scalar info in either order+-- e.g. `INTEGER x; DIMENSION x(2)` or `DIMENSION x(2); INTEGER x`. This+-- function handles just the former case. (Ideally we handle both+-- interchangeably, but the fortran-vars type representation isn't conducive.)+upgradeScalarToArray :: Name -> AList DimensionDeclarator (Analysis a) -> SymbolTable -> SymbolTable-updateDimensionDimensionDeclarator symbol dimDecls symTable =+upgradeScalarToArray symbol dimDecls symTable = case M.lookup symbol symTable of- Just (SVariable TArray{} _) -> error- (symbol- ++ "is array-typed Varible. \- \Invalid fortran syntax (Duplicate DIMENSION attribute)"- )+ Just (SVariable TArray{} _) ->+ error $ symbol <> " is array-typed variable."+ <> " Invalid fortran syntax (Duplicate DIMENSION attribute)" Just (SVariable ty loc) -> let mdims = traverse (resolveDimensionDimensionDeclarator symTable) (aStrip dimDecls)@@ -246,108 +289,6 @@ in M.insert symbol entry symTable _ -> symTable -handleDimension- :: Data a => SymbolTable -> AList Declarator (Analysis a) -> SymbolTable-handleDimension symTable decls = foldl' f symTable (aStrip decls)- where- f symt (DeclArray _ _ varExp dimDecls _ _) =- updateDimensionDimensionDeclarator (srcName varExp) dimDecls symt- f symt _ = symt---- | Given symbol, list of Arguments and SymbolTable, it updates the relevant--- variable in the SymbolTable to become an array with dimensions described by--- the list of Arguments.------ This function is needed to handle dimensions specifications within COMMONs,--- because fortran-src doesn't support 'DimensionDeclarator's within COMMON blocks.-updateDimensionExpFunctionCall- :: Name -> AList Argument (Analysis a) -> SymbolTable -> SymbolTable-updateDimensionExpFunctionCall symbol args symTable =- case M.lookup symbol symTable of- Just (SVariable TArray{} _) -> error- (symbol- ++ " is array-typed VaribleEntry. \- \Invalid fortran syntax (Duplicate DIMENSION attribute)"- )- Just (SVariable std loc) ->- let dims =- traverse (resolveDimensionExpFunctionCall symTable) (aStrip args)- entry = SVariable (TArray std dims) loc- in M.insert symbol entry symTable- Just (SDummy _) -> error- (symbol- ++ " is DummyVariableEntry. \- \Invalid fortran syntax (Dummy in COMMON dimension declaration)"- )- Nothing ->- let dims =- traverse (resolveDimensionExpFunctionCall symTable) (aStrip args)- -- Set default kind; there is no way to know it at this point- entry = SVariable (TArray (TInteger 4) dims) (symbol, 0)- in M.insert symbol entry symTable- _ -> error- (symbol- ++ " was found in SymbolTable. This case is not possible, \- \because ExpFunctionCall as dimension declarator can only occur for \- \variables that occur after COMMON block in the code"- )---- | Given symbol, list of Indices and SymbolTable, it updates the relevant--- variable in the SymbolTable to become an array with dimensions described by--- the list of Indices.------ This function is needed to handle dimensions specifications within COMMONs,--- because fortran-src doesn't support 'DimensionDeclarator's within COMMON blocks.-updateDimensionExpSubscript- :: Name -> AList Index (Analysis a) -> SymbolTable -> SymbolTable-updateDimensionExpSubscript symbol indices symTable =- case M.lookup symbol symTable of- Just (SVariable TArray{} _) -> error- (symbol- ++ " is array-typed VaribleEntry. \- \Invalid fortran syntax (Duplicate DIMENSION attribute)"- )- Just (SVariable std loc) ->- let dims =- traverse (resolveDimensionExpSubscript symTable) (aStrip indices)- entry = SVariable (TArray std dims) loc- in M.insert symbol entry symTable- Just (SDummy _) -> error- (symbol- ++ " is DummyVariableEntry. \- \Invalid fortran syntax (Dummy in COMMON dimension declaration)"- )- Nothing ->- let dims =- traverse (resolveDimensionExpSubscript symTable) (aStrip indices)- -- Set default kind; there is no way to know it at this point- entry = SVariable (TArray (TInteger 4) dims) (symbol, 0)- in M.insert symbol entry symTable- _ -> error "Invalid fortran syntax"--handleCommon- :: Data a => SymbolTable -> AList CommonGroup (Analysis a) -> SymbolTable-handleCommon symTable alist = foldl' f symTable (aStrip alist)- where- f symt (CommonGroup _ _ _ alist2) = foldl' f2 symt (aStrip alist2)- where- f2 symt2 (ExpFunctionCall _ _ varExp (Just alist3)) =- updateDimensionExpFunctionCall (srcName varExp) alist3 symt2- f2 symt2 (ExpSubscript _ _ varExp alist3) =- updateDimensionExpSubscript (srcName varExp) alist3 symt2- f2 symt2 _ = symt2---- | Given a 'SymbolTable' and a 'Statement' found in a 'ProgramUnit', return a new 'SymbolTable'--- with any newly defined symbols-stSymbols :: Data a => SymbolTable -> Statement (Analysis a) -> SymbolTable-stSymbols symTable (StParameter _ _ alist) = handleParameter symTable alist-stSymbols symTable (StDeclaration _ _ typespec _ decls) =- handleDeclaration symTable typespec decls-stSymbols symTable (StDimension _ _ decls ) = handleDimension symTable decls-stSymbols symTable (StCommon _ _ alist ) = handleCommon symTable alist-stSymbols symTable (StInclude _ _ _ (Just bls)) = foldl' blSymbols symTable bls-stSymbols symTable _ = symTable- -- | Given a 'Bool', 'SymbolTable' and a 'ProgramUnit', return an updated -- 'SymbolTable' containing symbols defined in 'ProgramUnit' signature, e.g. -- integer function fname() -> symbol table containing 'fname'@@ -386,12 +327,11 @@ then Just $ toType d else declToType symt name tyspec ds where- getName (DeclArray _ _ (ExpValue _ _ (ValVariable str)) _ _ _) = str- getName (DeclVariable _ _ (ExpValue _ _ (ValVariable str)) _ _) = str+ getName (Declarator _ _ (ExpValue _ _ (ValVariable str)) _ _ _) = str getName _ = error "Unexpected declaration expression"- toType (DeclArray _ _ _ dims _ _) =+ toType (Declarator _ _ _ (ArrayDecl dims) _ _) = typeSpecToArrayType symt (aStrip dims) tyspec- toType DeclVariable{} = typeSpecToScalarType symt tyspec+ toType (Declarator _ _ _ ScalarDecl _ _) = typeSpecToScalarType symt tyspec declToType _ _ _ [] = Nothing -- | Update SymbolTable for a given block, traverse statements to get
src/Language/Fortran/Vars/TypeCheck.hs view
@@ -29,6 +29,10 @@ , BinaryOp(..) , Index(..) )+import Language.Fortran.AST.RealLit ( RealLit(..)+ , Exponent(..)+ , ExponentLetter(..)+ ) import Language.Fortran.Intrinsics ( getVersionIntrinsics , getIntrinsicReturnType , IntrinsicType(..)@@ -54,6 +58,7 @@ import Language.Fortran.Vars.Kind ( getTypeKind , setTypeKind+ , toInt ) import Language.Fortran.Vars.Eval ( eval' )@@ -140,11 +145,13 @@ -> Value a -> Either TypeError Type typeOfValue sp strTable symTable v = case v of- ValInteger i -> case readMaybe @Int i of- Just _ -> Right $ TInteger 4- Nothing -> Right $ TByte 4- ValReal r | 'D' `elem` map toUpper r -> Right (TReal 8)- | otherwise -> Right (TReal 4)+ ValInteger _ mkp -> Right $ TInteger (kpOrDef 4 mkp)+ ValReal r _ -> -- TODO ignoring kind param+ let k = case exponentLetter (realLitExponent r) of+ ExpLetterE -> 4+ ExpLetterD -> 8+ ExpLetterQ -> 16+ in Right $ TReal k ValComplex real imaginary -> do tr <- typeOf strTable symTable real ti <- typeOf strTable symTable imaginary@@ -153,9 +160,17 @@ else return (TComplex 8) ValString s -> Right $ TCharacter (CharLenInt (length s)) 1 ValHollerith s -> Right . TByte $ length s- ValLogical _ -> Right $ TLogical 4+ ValLogical _ mkp -> Right $ TLogical (kpOrDef 4 mkp)+ ValBoz b -> Right $ TByte 4 _ -> Left $ UnknownType sp-+ where+ evalMaybeKind k = either (const Nothing) (Just . toInt) $ eval' symTable k+ -- TODO ignoring kind param errors (should report better)+ kpOrDef kDef = \case+ Nothing -> kDef+ Just kp -> case evalMaybeKind kp of+ Nothing -> kDef+ Just k -> k promote :: Type -> Type -> Type promote t1 t2
src/Language/Fortran/Vars/Types.hs view
@@ -27,6 +27,7 @@ , Expression , Kind )+import qualified Language.Fortran.AST.Boz as AST import Language.Fortran.Util.Position ( SrcSpan(..) , Position(..) )@@ -42,9 +43,13 @@ | Real Double | Str String | Logical Bool- | Boz String+ | Boz AST.Boz deriving (Eq, Ord, Show, Data, Typeable, Generic, NFData) +instance FromJSON AST.Boz+instance ToJSON AST.Boz+instance FromJSON AST.BozPrefix+instance ToJSON AST.BozPrefix instance FromJSON ExpVal instance ToJSON ExpVal
test/AssignmentsSpec.hs view
@@ -36,7 +36,7 @@ length stmts `shouldBe` 9 map fst stmts `shouldBe` replicate 9 (TReal 4) let getVal = \case- ExpValue _ _ (ValInteger s) -> s+ ExpValue _ _ (ValInteger s _) -> s _ -> error "Not value" map (getVal . snd) stmts `shouldBe` ["1", "0", "0", "0", "1", "0", "0", "0", "1"]
test/BozConstantSpec.hs view
@@ -1,4 +1,4 @@-module BozConstantSpec where+module BozConstantSpec ( spec ) where import Test.Hspec @@ -9,41 +9,44 @@ ) import Language.Fortran.Vars.Types ( ExpVal(..) )+import qualified Language.Fortran.AST.Boz as AST +boz :: String -> ExpVal+boz = Boz . AST.parseBoz spec :: Spec spec = describe "Boz Constant Conversion" $ do it "Mixed case BOZ constant conversions" $ do- bozToInt2 (Boz "'ffff'x") `shouldBe` Int (-1)- bozToInt2 (Boz "'FfFf'x") `shouldBe` Int (-1)- bozToInt4 (Boz "'FFFFFFFF'x") `shouldBe` Int (-1)+ bozToInt2 (boz "'ffff'x") `shouldBe` Int (-1)+ bozToInt2 (boz "'FfFf'x") `shouldBe` Int (-1)+ bozToInt4 (boz "'FFFFFFFF'x") `shouldBe` Int (-1) it "BOZ constant to Integer*2" $ do- bozToInt2 (Boz "'1'x") `shouldBe` Int 1- bozToInt2 (Boz "'10'x") `shouldBe` Int 16- bozToInt2 (Boz "'7fff'x") `shouldBe` Int 32767- bozToInt2 (Boz "'8000'x") `shouldBe` Int (-32768)- bozToInt2 (Boz "'ffff'x") `shouldBe` Int (-1)+ bozToInt2 (boz "'1'x") `shouldBe` Int 1+ bozToInt2 (boz "'10'x") `shouldBe` Int 16+ bozToInt2 (boz "'7fff'x") `shouldBe` Int 32767+ bozToInt2 (boz "'8000'x") `shouldBe` Int (-32768)+ bozToInt2 (boz "'ffff'x") `shouldBe` Int (-1) it "BOZ constant to Integer*4" $ do- bozToInt4 (Boz "'1'x") `shouldBe` Int 1- bozToInt4 (Boz "'10'x") `shouldBe` Int 16- bozToInt4 (Boz "'7fff'x") `shouldBe` Int 32767- bozToInt4 (Boz "'8000'x") `shouldBe` Int 32768- bozToInt4 (Boz "'ffff'x") `shouldBe` Int 65535- bozToInt4 (Boz "'7fffffff'x") `shouldBe` Int 2147483647- bozToInt4 (Boz "'80000000'x") `shouldBe` Int (-2147483648)- bozToInt4 (Boz "'ffffffff'x") `shouldBe` Int (-1)+ bozToInt4 (boz "'1'x") `shouldBe` Int 1+ bozToInt4 (boz "'10'x") `shouldBe` Int 16+ bozToInt4 (boz "'7fff'x") `shouldBe` Int 32767+ bozToInt4 (boz "'8000'x") `shouldBe` Int 32768+ bozToInt4 (boz "'ffff'x") `shouldBe` Int 65535+ bozToInt4 (boz "'7fffffff'x") `shouldBe` Int 2147483647+ bozToInt4 (boz "'80000000'x") `shouldBe` Int (-2147483648)+ bozToInt4 (boz "'ffffffff'x") `shouldBe` Int (-1) it "BOZ constant to Integer*8" $ do- bozToInt8 (Boz "'1'x") `shouldBe` Int 1- bozToInt8 (Boz "'10'x") `shouldBe` Int 16- bozToInt8 (Boz "'7fff'x") `shouldBe` Int 32767- bozToInt8 (Boz "'8000'x") `shouldBe` Int 32768- bozToInt8 (Boz "'ffff'x") `shouldBe` Int 65535- bozToInt8 (Boz "'7fffffff'x") `shouldBe` Int 2147483647- bozToInt8 (Boz "'80000000'x") `shouldBe` Int 2147483648- bozToInt8 (Boz "'ffffffff'x") `shouldBe` Int 4294967295- bozToInt8 (Boz "'7fffffffffffffff'x") `shouldBe` Int 9223372036854775807- --bozToInt8 (Boz "'8000000000000000'x") `shouldBe` Int (-9223372036854775808)- --bozToInt8 (Boz "'ffffffffffffffff'x") `shouldBe` Int (-1)+ bozToInt8 (boz "'1'x") `shouldBe` Int 1+ bozToInt8 (boz "'10'x") `shouldBe` Int 16+ bozToInt8 (boz "'7fff'x") `shouldBe` Int 32767+ bozToInt8 (boz "'8000'x") `shouldBe` Int 32768+ bozToInt8 (boz "'ffff'x") `shouldBe` Int 65535+ bozToInt8 (boz "'7fffffff'x") `shouldBe` Int 2147483647+ bozToInt8 (boz "'80000000'x") `shouldBe` Int 2147483648+ bozToInt8 (boz "'ffffffff'x") `shouldBe` Int 4294967295+ bozToInt8 (boz "'7fffffffffffffff'x") `shouldBe` Int 9223372036854775807+ bozToInt8 (boz "'8000000000000000'x") `shouldBe` Int (-9223372036854775808)+ bozToInt8 (boz "'ffffffffffffffff'x") `shouldBe` Int (-1)
test/EvalSpec.hs view
@@ -28,8 +28,8 @@ dSym = M.empty true, false :: Expression A0-true = ExpValue () dSpan $ ValLogical ".TRUE."-false = ExpValue () dSpan $ ValLogical ".FALSE."+true = ExpValue () dSpan $ ValLogical True Nothing+false = ExpValue () dSpan $ ValLogical False Nothing foobar :: Expression A0 foobar = ExpValue () dSpan $ ValVariable "foobar"@@ -84,6 +84,6 @@ evalWithShortcircuit dSym ex `shouldBe` Right (Logical True) it "Can handle conditions with non-logical logic" $ do -- .TRUE. .EQ. 1- let vx = ExpValue () dSpan $ ValInteger "1"+ let vx = ExpValue () dSpan $ ValInteger "1" Nothing ex = ExpBinary () dSpan EQ true vx evalWithShortcircuit dSym ex `shouldBe` Right (Logical True)
test/StructureTableSpec.hs view
@@ -93,9 +93,6 @@ ] it "structures and subscripts" $ do- pending- {- TODO: 2021-09-06: fails with fortran-src ErrorCall: Use of varName on- non-variable pf <- getTestProgramAnalysis "test/structure_table/structure4.f" let pus = allPU pf sts = map collectSymbols pus@@ -120,7 +117,6 @@ ] ) ]- -} describe "Union tests" $ do@@ -187,9 +183,6 @@ typeOf structTable st expr `shouldBe` Right (TCharacter (CharLenInt 13) 1) it "Get combination of data references and subscripts" $ do- pending- {- TODO: 2021-09-06: fails with fortran-src ErrorCall: Use of varName on- non-variable pf <- getTestProgramAnalysis "test/structure_table/structure4.f" let pus = allPU pf logics@@ -212,7 +205,6 @@ , Right (TArray (TInteger 1) (Just [(1, 3)])) ] mapM_ (uncurry testStructureTablePU) $ zip pus logics- -} it "Character substrings" $ do pf <- getTestProgramAnalysis "test/structure_table/structure5.f"
test/SymbolTableSpec.hs view
@@ -383,9 +383,8 @@ valueOf "var_from_includee" symTable `shouldBe` Str "includee" it "Interface include" $ do+ -- TODO 2021-09-06: fails with fortran-src ParseError: interface.inc: lexing failed pending- {- TODO: 2021-09-06: fails with fortran-src ParseError: interface.inc:- lexing failed contents <- flexReadFile path_interface symTable <- getSymTableIO path_interface contents unitName @@ -395,7 +394,6 @@ -- Check we don't pick up subroutines or arguments M.member "index" symTable `shouldBe` False M.member "sespit_set_trdnum" symTable `shouldBe` False- -} describe "BOZ constants: " $ do