bond 0.4.1.0 → 0.5.0.0

raw patch · 12 files changed

+148/−40 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• bond.cabal +1/−1
• src/Language/Bond/Codegen/Cpp/ApplyOverloads.hs +15/−12
• src/Language/Bond/Codegen/Cpp/Apply_cpp.hs +1/−1
• src/Language/Bond/Codegen/Cpp/Apply_h.hs +1/−1
• src/Language/Bond/Codegen/Cpp/Types_h.hs +23/−7
• src/Language/Bond/Codegen/Cpp/Util.hs +3/−1
• src/Language/Bond/Codegen/TypeMapping.hs +16/−2
• src/Language/Bond/Parser.hs +46/−5
• src/Language/Bond/Syntax/SchemaDef.hs +13/−9
• src/Language/Bond/Syntax/Util.hs +7/−0
• tests/Main.hs +9/−0
• tests/Tests/Syntax.hs +13/−1

@@ -2,7 +2,7 @@ -- Licensed under the MIT license. See LICENSE file in the project root for full license information.
 
 name:               bond
-version:            0.4.1.0
+version:            0.5.0.0
 cabal-version:      >= 1.8
 tested-with:        GHC>=7.4.1
 synopsis:           Bond schema compiler and code generator

@@ -10,6 +10,7 @@ import Data.Text.Lazy (Text)
 import Text.Shakespeare.Text
 import Language.Bond.Syntax.Types
+import Language.Bond.Codegen.TypeMapping
 import Language.Bond.Codegen.Util
 
 -- | Protocol data type is used to specify what protocols the @Apply@ function
@@ -22,20 +23,22 @@ 
 
 -- Apply overloads
-applyOverloads :: [Protocol] -> Text -> Text -> Declaration -> Text
-applyOverloads protocols attr body Struct {..} | null declParams = [lt|
+applyOverloads :: [Protocol] -> MappingContext -> Text -> Text -> Declaration -> Text
+applyOverloads protocols cpp attr body s@Struct {..} | null declParams = [lt|
     //
     // Overloads of Apply function with common transforms for #{declName}.
     // These overloads will be selected using argument dependent lookup
     // before bond::Apply function templates.
     //
-    #{attr}bool Apply(const bond::To<#{declName}>& transform,
-               const bond::bonded<#{declName}>& value)#{body}
+    #{attr}bool Apply(const bond::To< #{qualifiedName}>& transform,
+               const bond::bonded< #{qualifiedName}>& value)#{body}
 
     #{attr}bool Apply(const bond::InitSchemaDef& transform,
-               const #{declName}& value)#{body}
+               const #{qualifiedName}& value)#{body}
     #{newlineSep 1 applyOverloads' protocols}|]
   where
+    qualifiedName = getDeclTypeName cpp s
+
     applyOverloads' p = [lt|#{deserialization p}
     #{serialization serializer p}
     #{serialization marshaler p}|]
@@ -44,22 +47,22 @@     marshaler = "Marshaler" :: String
 
     deserialization Protocol {..} = [lt|
-    #{attr}bool Apply(const bond::To<#{declName}>& transform,
-               const bond::bonded<#{declName}, #{protocolReader}&>& value)#{body}
+    #{attr}bool Apply(const bond::To< #{qualifiedName}>& transform,
+               const bond::bonded< #{qualifiedName}, #{protocolReader}&>& value)#{body}
 
-    #{attr}bool Apply(const bond::To<#{declName}>& transform,
+    #{attr}bool Apply(const bond::To< #{qualifiedName}>& transform,
                const bond::bonded<void, #{protocolReader}&>& value)#{body}|]
 
     serialization transform Protocol {..} = [lt|
     #{attr}bool Apply(const bond::#{transform}<#{protocolWriter} >& transform,
-               const #{declName}& value)#{body}
+               const #{qualifiedName}& value)#{body}
 
     #{attr}bool Apply(const bond::#{transform}<#{protocolWriter} >& transform,
-               const bond::bonded<#{declName}>& value)#{body}
+               const bond::bonded< #{qualifiedName}>& value)#{body}
     #{newlineSep 1 (transcoding transform) protocols}|]
       where
         transcoding transform' Protocol {protocolReader = fromReader} = [lt|
     #{attr}bool Apply(const bond::#{transform'}<#{protocolWriter} >& transform,
-               const bond::bonded<#{declName}, #{fromReader}&>& value)#{body}|]
+               const bond::bonded< #{qualifiedName}, #{fromReader}&>& value)#{body}|]
 
-applyOverloads _ _ _ _ = mempty
+applyOverloads _ _ _ _ _ = mempty

@@ -22,7 +22,7 @@ #include "#{file}_reflection.h"
 
 #{CPP.openNamespace cpp}
-    #{newlineSepEnd 1 (applyOverloads protocols attr body) declarations}
+    #{newlineSepEnd 1 (applyOverloads protocols cpp attr body) declarations}
 #{CPP.closeNamespace cpp}
 |])
   where

@@ -31,7 +31,7 @@ #{newlineSep 0 includeImport imports}
 
 #{CPP.openNamespace cpp}
-    #{newlineSepEnd 1 (applyOverloads protocols attr semi) declarations}
+    #{newlineSepEnd 1 (applyOverloads protocols cpp attr semi) declarations}
 #{CPP.closeNamespace cpp}
 |])
   where

@@ -25,7 +25,7 @@ import qualified Language.Bond.Codegen.Cpp.Util as CPP
 
 -- | Codegen template for generating /base_name/_type.h containing definitions
--- of C++ types representing the schema. 
+-- of C++ types representing the schema.
 types_h :: [String]     -- ^ list of optional header files to be @#include@'ed by the generated code
         -> Bool         -- ^ 'True' to generate enum definitions into a separate file /base_name/_enum.h
         -> Maybe String -- ^ optional custom allocator to be used in the generated code
@@ -35,7 +35,7 @@ #{newlineBeginSep 0 includeHeader userHeaders}
 #include <bond/core/bond_version.h>
 
-#if BOND_VERSION < 0x302
+#if BOND_VERSION < 0x0422
 #error This file was generated by a newer version of Bond compiler
 #error and is incompatible with your version Bond library.
 #endif
@@ -59,7 +59,7 @@     hexVersion (Version xs _) = foldr showHex "" xs
     cppType = getTypeName cpp
 
-    idl = MappingContext idlTypeMapping [] [] []  
+    idl = MappingContext idlTypeMapping [] [] []
 
     cppDefaultValue = CPP.defaultValue cpp
 
@@ -146,13 +146,13 @@         #{initMetadata}
     };
 
-    #{template}inline void swap(#{structName}& left, #{structName}& right)
+    #{template}inline void swap(#{qualifiedStructName}& left, #{qualifiedStructName}& right)
     {
         left.swap(right);
     }|]
       where
         template = CPP.template s
-        structName = CPP.structName s
+        qualifiedStructName = [lt|#{getDeclTypeName cpp s}#{CPP.structParams s}|]
 
         otherParam = if hasOnlyMetaFields then mempty else [lt| other|]
         hasOnlyMetaFields = not (any (not . getAny . metaField) structFields) && isNothing structBase
@@ -265,9 +265,25 @@                 getAllocator _ = mempty
 
         -- move constructor
-        moveCtor = CPP.ifndef CPP.rvalueReferences [lt|
-        #{declName}(#{declName}&&#{param})#{initList}#{ctorBody}|]
+        moveCtor = if hasMetaFields then [lt|
+#if !defined(#{CPP.rvalueReferences})
+        #{explicit}
+#endif|]
+            -- even if implicit would be okay, fall back to explicit for
+            -- compilers that don't support = default for move constructors
+                                    else [lt|
+#if !defined(#{CPP.defaultedMoveCtors})
+        #{implicit}
+#elif !defined(#{CPP.rvalueReferences})
+        #{explicit}
+#endif|]
           where
+            -- default OK when there are no meta fields
+            implicit = [lt|#{declName}(#{declName}&& other) = default;|]
+
+            -- define ctor to perform member-by-member move and--if
+            -- needed--initialize meta fields
+            explicit = [lt|#{declName}(#{declName}&&#{param})#{initList}#{ctorBody}|]
             initList = initializeList
                 (optional baseMove structBase)
                 (commaLineSep 3 fieldMove structFields)

@@ -16,6 +16,7 @@     , schemaMetadata
     , ifndef
     , defaultedFunctions
+    , defaultedMoveCtors
     , rvalueReferences
     , enumDefinition
     ) where
@@ -123,8 +124,9 @@         staticCast d = [lt|static_cast<#{getTypeName cpp fieldType}>(#{defaultValue cpp fieldType d})|]
 schemaMetadata _ _ = error "schemaMetadata: impossible happened."
 
-defaultedFunctions, rvalueReferences :: Text
+defaultedFunctions, defaultedMoveCtors, rvalueReferences :: Text
 defaultedFunctions = [lt|BOND_NO_CXX11_DEFAULTED_FUNCTIONS|]
+defaultedMoveCtors = [lt|BOND_NO_CXX11_DEFAULTED_MOVE_CTOR|]
 rvalueReferences = [lt|BOND_NO_CXX11_RVALUE_REFERENCES|]
 
 ifndef :: ToText a => a -> Text -> Text

@@ -17,7 +17,8 @@ module Language.Bond.Codegen.TypeMapping
     ( -- * Mapping context
       MappingContext(..)
-    , TypeMapping
+    , TypeMapping(..)
+    , TypeNameBuilder
       -- * Type mappings
     , idlTypeMapping
     , cppTypeMapping
@@ -48,6 +49,11 @@     , getNamespace
     , getDeclNamespace
     , customAliasMapping
+      -- * TypeMapping helper functions
+    , elementTypeName
+    , aliasTypeName
+    , declTypeName
+    , declQualifiedTypeName
     ) where
 
 import Data.List
@@ -74,7 +80,7 @@     , namespaces :: [Namespace]
     }
 
--- | An opaque type representing a type mapping.
+-- | A type representing a type mapping.
 data TypeMapping = TypeMapping
     { language :: Maybe Language
     , global :: Builder
@@ -237,6 +243,8 @@ localWith :: (TypeMapping -> TypeMapping) -> TypeNameBuilder -> TypeNameBuilder
 localWith f = local $ \c -> c { typeMapping = f $ typeMapping c }
 
+-- | Builder for nested element types (e.g. list elements) in context of 'TypeNameBuilder' monad. 
+-- Used to implement 'mapType' function of 'TypeMapping'.
 elementTypeName :: Type -> TypeNameBuilder
 elementTypeName = localWith elementMapping . typeName
 
@@ -260,11 +268,15 @@ declQualifiedName :: MappingContext -> Declaration -> QualifiedName
 declQualifiedName c decl = getDeclNamespace c decl ++ [declName decl]
 
+-- | Builder for the qualified name for a 'Declaration' in context of 'TypeNameBuilder' monad.
+-- Used to implement 'mapType' function of 'TypeMapping'.
 declQualifiedTypeName :: Declaration -> TypeNameBuilder
 declQualifiedTypeName decl = do
     ctx <- ask
     return $ getDeclTypeName ctx decl
 
+-- | Builder for the name for a 'Declaration' in context of 'TypeNameBuilder' monad.
+-- Used to implement 'mapType' function of 'TypeMapping'.
 declTypeName :: Declaration -> TypeNameBuilder
 declTypeName decl = do
     ctx <- ask
@@ -279,6 +291,8 @@     isSameNs = namespaces ctx == declNamespaces a
     isSameAlias m = aliasDeclName == aliasName m || isSameNs && [declName a] == aliasName m
 
+-- | Builder for the type alias name in context of 'TypeNameBuilder' monad.
+-- Used to implement 'mapType' function of 'TypeMapping'.
 aliasTypeName :: Declaration -> [Type] -> TypeNameBuilder
 aliasTypeName a args = do
     ctx <- ask

@@ -1,7 +1,7 @@ -- Copyright (c) Microsoft. All rights reserved.
 -- Licensed under the MIT license. See LICENSE file in the project root for full license information.
 
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}
 
 {-|
 Copyright   : (c) Microsoft
@@ -24,6 +24,7 @@ import Data.Ord
 import Data.List
 import Data.Function
+import Data.Int
 import Data.Word
 import Control.Applicative
 import Control.Monad.Reader
@@ -247,13 +248,17 @@ 
 -- field definition parser
 field :: Parser Field
-field = makeField <$> attributes <*> ordinal <*> modifier <*> ftype <*> identifier <*> optional default_
+field = do
+    mf <- makeField <$> attributes <*> ordinal <*> modifier <*> ftype <*> identifier <*> optional default_
+    case mf of
+      Left e -> fail e
+      Right f -> return f
   where
     ordinal = word16 <* colon <?> "field ordinal"
       where
         word16 = do
             i <- integer
-            if i <= toInteger (maxBound :: Word16) && i >= toInteger (minBound :: Word16)
+            if isInBounds i (0::Word16)
                 then return (fromInteger i)
                 else fail "Field ordinal must be within the range 0-65535"
     modifier = option Optional
@@ -268,8 +273,44 @@                  <|> DefaultEnum <$> identifier
                  <|> DefaultFloat <$> try float
                  <|> DefaultInteger <$> fromIntegral <$> integer)
-    makeField a o m t n d@(Just DefaultNothing) = Field a o m (BT_Maybe t) n d
-    makeField a o m t n d = Field a o m t n d
+    makeField a o m t n d@(Just DefaultNothing)
+        | isStruct t = Left "Struct field can't have default value of 'nothing'"
+        | otherwise  = Right $ Field a o m (BT_Maybe t) n d
+    makeField a o m t n d
+        | d == Nothing && isEnum t = Left "Enum field must have a default value"
+        | otherwise                = if validDefaultType t d
+                                        then Right $ Field a o m t n d
+                                        else Left "Invalid default value for field"
+
+-- default type validator (type checking, out-of-range, enforce default type)
+validDefaultType :: Type -> Maybe Default -> Bool
+validDefaultType (BT_UserDefined a@Alias {} args) d = validDefaultType (resolveAlias a args) d
+validDefaultType _ Nothing = True
+validDefaultType bondType (Just defaultValue) = validDefaultType' bondType defaultValue
+  where validDefaultType' :: Type -> Default -> Bool
+        validDefaultType' BT_Int8    (DefaultInteger i) = isInBounds i (0::Int8)
+        validDefaultType' BT_Int16   (DefaultInteger i) = isInBounds i (0::Int16)
+        validDefaultType' BT_Int32   (DefaultInteger i) = isInBounds i (0::Int32)
+        validDefaultType' BT_Int64   (DefaultInteger i) = isInBounds i (0::Int64)
+        validDefaultType' BT_UInt8   (DefaultInteger i) = isInBounds i (0::Word8)
+        validDefaultType' BT_UInt16  (DefaultInteger i) = isInBounds i (0::Word16)
+        validDefaultType' BT_UInt32  (DefaultInteger i) = isInBounds i (0::Word32)
+        validDefaultType' BT_UInt64  (DefaultInteger i) = isInBounds i (0::Word64)
+        validDefaultType' BT_Float   (DefaultFloat _)   = True
+        validDefaultType' BT_Float   (DefaultInteger _) = True
+        validDefaultType' BT_Double  (DefaultFloat _)   = True
+        validDefaultType' BT_Double  (DefaultInteger _) = True
+        validDefaultType' BT_Bool    (DefaultBool _)    = True
+        validDefaultType' BT_String  (DefaultString _)  = True
+        validDefaultType' BT_WString (DefaultString _)  = True
+        validDefaultType' (BT_UserDefined Enum {} _) (DefaultEnum _) = True
+        validDefaultType' (BT_TypeParam {}) _           = True
+        validDefaultType' _ _                           = False
+
+-- checks whether an Integer is within the bounds of some other Integral and Bounded type.
+-- The value of the second paramater is never used: only its type is used.
+isInBounds :: forall a. (Integral a, Bounded a) => Integer -> a -> Bool
+isInBounds value _ = value >= (toInteger (minBound :: a)) && value <= (toInteger (maxBound :: a))
 
 -- enum definition parser
 enum :: Parser Declaration

@@ -63,11 +63,15 @@ 
 data TypeDef =
     TypeDef
+          -- Domain of Int is BondDataType
         { id :: Maybe Int
+          -- Index of struct definition in SchemaDef.structs when id == BT_STRUCT
         , struct_def :: Maybe Int
         , element :: Maybe [TypeDef]
         , key :: Maybe [TypeDef]
         , bonded_type :: Maybe Bool
+          -- Domain of Int is ListSubType
+        , list_sub_type :: Maybe Int
         }
 
 data Metadata =
@@ -170,19 +174,19 @@     -- TypeDef for specified type
     typeDef typ
         | isScalar typ || isString typ || isMetaName typ
-                             = TypeDef (Just $ typeId typ) Nothing Nothing Nothing Nothing
+                             = TypeDef (Just $ typeId typ) Nothing Nothing Nothing Nothing Nothing
         | otherwise = case typ of
-            BT_Blob         -> listDef BT_Int8
-            (BT_List t)     -> listDef t
-            (BT_Vector t)   -> listDef t
-            (BT_Nullable t) -> listDef t
-            (BT_Set t)      -> TypeDef (Just 12) Nothing (Just [typeDef t]) Nothing Nothing
-            (BT_Map k t)    -> TypeDef (Just 13) Nothing (Just [typeDef t]) (Just [typeDef k]) Nothing
+            BT_Blob         -> listDef BT_Int8 (Just 2)
+            (BT_List t)     -> listDef t Nothing
+            (BT_Vector t)   -> listDef t Nothing
+            (BT_Nullable t) -> listDef t (Just 1)
+            (BT_Set t)      -> TypeDef (Just 12) Nothing (Just [typeDef t]) Nothing Nothing Nothing
+            (BT_Map k t)    -> TypeDef (Just 13) Nothing (Just [typeDef t]) (Just [typeDef k]) Nothing Nothing
             (BT_Bonded t)   -> (typeDef t) {bonded_type = Just True}
             (BT_Maybe t)    -> typeDef t
-            t               -> TypeDef Nothing (Just (structIdx t)) Nothing Nothing Nothing
+            t               -> TypeDef Nothing (Just (structIdx t)) Nothing Nothing Nothing Nothing
       where
-        listDef t = TypeDef (Just 11) Nothing (Just [typeDef t]) Nothing Nothing
+        listDef t list_sub_type = TypeDef (Just 11) Nothing (Just [typeDef t]) Nothing Nothing list_sub_type
     variant = Variant Nothing Nothing Nothing Nothing Nothing Nothing
     attr [] = Nothing
     attr xs = Just $ concatMap (\a -> [qualifiedName $ attrName a, attrValue a]) xs

@@ -26,6 +26,7 @@     , isAssociative
     , isNullable
     , isStruct
+    , isEnum
     , isMetaName
       -- * Type mapping
     , fmapType
@@ -126,6 +127,12 @@ isStruct (BT_UserDefined Forward {} _) = True
 isStruct (BT_UserDefined a@Alias {} args) = isStruct $ resolveAlias a args
 isStruct _ = False
+
+-- | Returns 'True' if the type represents an enum
+isEnum :: Type -> Bool
+isEnum (BT_UserDefined Enum {} _) = True
+isEnum (BT_UserDefined a@Alias {} args) = isEnum $ resolveAlias a args
+isEnum _ = False
 
 -- | Returns 'True' if the type represents a nullable type.
 isNullable :: Type -> Bool

@@ -15,6 +15,7 @@         , testGroup "Compare .bond and .json"
             [ testCase "attributes" $ compareAST "attributes"
             , testCase "basic types" $ compareAST "basic_types"
+            , testCase "bond_meta types" $ compareAST "bond_meta"
             , testCase "complex types" $ compareAST "complex_types"
             , testCase "default values" $ compareAST "defaults"
             , testCase "empty" $ compareAST "empty"
@@ -45,10 +46,17 @@     , testGroup "Types"
         [ testCase "type alias resolution" aliasResolution
         ]
+    , testGroup "Codegen Failures (Expect to see errors below check for OK or FAIL)"
+        [ testCase "Struct default value nothing" $ failBadSyntax "Should fail when default value of a struct field is 'nothing'" "struct_nothing"
+        , testCase "Enum no default value" $ failBadSyntax "Should fail when an enum field has no default value" "enum_no_default"
+        , testCase "Alias default value" $ failBadSyntax "Should fail when underlying default value is of the wrong type" "aliases_default"
+        , testCase "Out of range" $ failBadSyntax "Should fail, out of range for int16" "int_out_of_range"
+        ]
     , testGroup "Codegen"
         [ testGroup "C++"
             [ verifyCppCodegen "attributes"
             , verifyCppCodegen "basic_types"
+            , verifyCppCodegen "bond_meta"
             , verifyCppCodegen "complex_types"
             , verifyCppCodegen "defaults"
             , verifyCppCodegen "empty"
@@ -92,6 +100,7 @@     , testGroup "C#"
             [ verifyCsCodegen "attributes"
             , verifyCsCodegen "basic_types"
+            , verifyCsCodegen "bond_meta"
             , verifyCsCodegen "complex_types"
             , verifyCsCodegen "defaults"
             , verifyCsCodegen "empty"

@@ -1,16 +1,18 @@ -- Copyright (c) Microsoft. All rights reserved.
 -- Licensed under the MIT license. See LICENSE file in the project root for full license information.
 
-{-# LANGUAGE OverloadedStrings, RecordWildCards, TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings, RecordWildCards, TemplateHaskell, ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Tests.Syntax
     ( roundtripAST
     , compareAST
+    , failBadSyntax
     , aliasResolution
     , verifySchemaDef
     ) where
 
+import Control.Exception
 import Data.Maybe
 import Data.List
 import Data.Aeson (encode, decode)
@@ -45,6 +47,16 @@ 
 roundtripAST :: Bond -> Bool
 roundtripAST x = (decode . encode) x == Just x
+
+assertException :: String -> IO a -> Assertion
+assertException errMsg action = do
+    e <- try action
+    case e of
+        Left (_ :: SomeException) -> return ()
+        Right _ -> assertFailure errMsg
+
+failBadSyntax :: String -> FilePath -> Assertion
+failBadSyntax errMsg file = assertException errMsg (parseBondFile [] $ "tests" </> "schema" </> "error" </> file <.> "bond")
 
 compareAST :: FilePath -> Assertion
 compareAST file = do