Merge pull request #317 from nikolaushuber/fix-semtype-print

Fix pretty printer for semantic types

Author: dorchard

CHANGELOG.md

@@ -1,3 +1,6 @@
+### (unreleased)
+  * Fixed pretty printing of array semantic types
+
 ### 0.16.7
   * Added mention of Fortran 2003 version support in the help message
   * Improved parsing of `allocate` statements

src/Language/Fortran/Analysis/SemanticTypes.hs

@@ -66,7 +66,7 @@ instance Pretty SemType where
       TLogical k -> "logical"<>pd k
       TByte    k -> "byte"<>pd k
       TCharacter _ _ -> "character(TODO)"
-      TArray st dims -> pprint' v st <> pprint' v dims
+      TArray st dims -> pprint' v st <> pdims v dims
       TCustom str -> pprint' v (TypeCustom str)
     | otherwise = \case
       TInteger k -> "integer"<>ad k
@@ -75,11 +75,13 @@ instance Pretty SemType where
       TLogical k -> "logical"<>ad k
       TByte    k -> "byte"<>ad k
       TCharacter _ _ -> "character*TODO"
-      TArray st dims -> pprint' v st <> pprint' v dims
+      TArray st dims -> pprint' v st <> pdims v dims
       TCustom str -> pprint' v (TypeCustom str)
     where
        pd = Pretty.parens . doc
        ad k = doc '*' <> doc k
+       pdims v dims = maybe Pretty.empty (pprint' v) (dimsTraverse dims)
+
 
 -- | Convert 'Dimensions' data type to its previous type synonym
 --   @(Maybe [(Int, Int)])@.

test/Language/Fortran/Analysis/SemanticTypesSpec.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 module Language.Fortran.Analysis.SemanticTypesSpec where
 
 import Test.Hspec
@@ -7,6 +10,10 @@ import Language.Fortran.Analysis.SemanticTypes
 import Language.Fortran.AST
 import Language.Fortran.Version
 
+import Language.Fortran.PrettyPrint
+import Text.PrettyPrint hiding ((<>))
+import Text.PrettyPrint.GenericPretty
+
 spec :: Spec
 spec = do
   describe "Semantic types" $ do
@@ -29,3 +36,9 @@ spec = do
       let semtype  = TCharacter CharLenStar 1
           typespec = TypeSpec () u TypeCharacter (Just (Selector () u (Just (ExpValue () u ValStar)) Nothing))
        in recoverSemTypeTypeSpec () u Fortran90 semtype `shouldBe` typespec
+
+    it "prints semantic type with dimensions" $ do
+      let dims = DimsExplicitShape ( [ Dim (Just 1) (Just 3), Dim (Just 1) (Just 4) ] )
+      let semtype  = TArray (TReal 8) dims
+      pprint Fortran90 semtype Nothing `shouldBe` "real(8)(1:3, 1:4)"
+