diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 + * Anthony Burzillo + * Azeem Bande-ali + * Benjamin Groh + * Chris Cotter + * Daniel Beer + * Darius Makovsky + * Eric Schneider + * Eric Seidel + * Jason Xu + * Kojo Adams + * Lukasz Kolodziejczyk + * Mario Longobardi + * Poppy Singleton-Hoare + * Raoul Hidalgo Charman + * Ti Liang diff --git a/fortran-vars.cabal b/fortran-vars.cabal --- a/fortran-vars.cabal +++ b/fortran-vars.cabal @@ -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 diff --git a/src/Language/Fortran/Vars/Assignments.hs b/src/Language/Fortran/Vars/Assignments.hs --- a/src/Language/Fortran/Vars/Assignments.hs +++ b/src/Language/Fortran/Vars/Assignments.hs @@ -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 diff --git a/src/Language/Fortran/Vars/BozConstant.hs b/src/Language/Fortran/Vars/BozConstant.hs --- a/src/Language/Fortran/Vars/BozConstant.hs +++ b/src/Language/Fortran/Vars/BozConstant.hs @@ -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 diff --git a/src/Language/Fortran/Vars/Memory.hs b/src/Language/Fortran/Vars/Memory.hs --- a/src/Language/Fortran/Vars/Memory.hs +++ b/src/Language/Fortran/Vars/Memory.hs @@ -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 diff --git a/src/Language/Fortran/Vars/Operation.hs b/src/Language/Fortran/Vars/Operation.hs --- a/src/Language/Fortran/Vars/Operation.hs +++ b/src/Language/Fortran/Vars/Operation.hs @@ -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 diff --git a/src/Language/Fortran/Vars/StorageClass.hs b/src/Language/Fortran/Vars/StorageClass.hs --- a/src/Language/Fortran/Vars/StorageClass.hs +++ b/src/Language/Fortran/Vars/StorageClass.hs @@ -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 diff --git a/src/Language/Fortran/Vars/StructureTable.hs b/src/Language/Fortran/Vars/StructureTable.hs --- a/src/Language/Fortran/Vars/StructureTable.hs +++ b/src/Language/Fortran/Vars/StructureTable.hs @@ -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 diff --git a/src/Language/Fortran/Vars/SymbolTable.hs b/src/Language/Fortran/Vars/SymbolTable.hs --- a/src/Language/Fortran/Vars/SymbolTable.hs +++ b/src/Language/Fortran/Vars/SymbolTable.hs @@ -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 diff --git a/src/Language/Fortran/Vars/TypeCheck.hs b/src/Language/Fortran/Vars/TypeCheck.hs --- a/src/Language/Fortran/Vars/TypeCheck.hs +++ b/src/Language/Fortran/Vars/TypeCheck.hs @@ -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 diff --git a/src/Language/Fortran/Vars/Types.hs b/src/Language/Fortran/Vars/Types.hs --- a/src/Language/Fortran/Vars/Types.hs +++ b/src/Language/Fortran/Vars/Types.hs @@ -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 diff --git a/test/AssignmentsSpec.hs b/test/AssignmentsSpec.hs --- a/test/AssignmentsSpec.hs +++ b/test/AssignmentsSpec.hs @@ -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"] diff --git a/test/BozConstantSpec.hs b/test/BozConstantSpec.hs --- a/test/BozConstantSpec.hs +++ b/test/BozConstantSpec.hs @@ -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) diff --git a/test/EvalSpec.hs b/test/EvalSpec.hs --- a/test/EvalSpec.hs +++ b/test/EvalSpec.hs @@ -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) diff --git a/test/StructureTableSpec.hs b/test/StructureTableSpec.hs --- a/test/StructureTableSpec.hs +++ b/test/StructureTableSpec.hs @@ -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" diff --git a/test/SymbolTableSpec.hs b/test/SymbolTableSpec.hs --- a/test/SymbolTableSpec.hs +++ b/test/SymbolTableSpec.hs @@ -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