From 10c6af1ad83324839ffa815c7053e0aa2d19e565 Mon Sep 17 00:00:00 2001 From: Jacob Leach Date: Wed, 13 Nov 2024 10:41:07 -0600 Subject: [PATCH 1/5] fix: add parsing for empty statements --- proto3-suite.cabal | 4 +- shell.nix | 1 + src/Proto3/Suite/DotProto/AST.hs | 1 - src/Proto3/Suite/DotProto/Parsing.hs | 68 +++++++++++++++++-------- src/Proto3/Suite/DotProto/Rendering.hs | 2 - test-files/test_proto_empty_field.proto | 15 ++++++ tests/Main.hs | 4 +- tests/Test/Proto/Generate/Name.hs | 6 +-- tests/Test/Proto/Parse.hs | 21 ++++++++ tests/Test/Proto/Parse/Core.hs | 24 +++++++++ tests/Test/Proto/Parse/Option.hs | 21 +++----- tests/TestCodeGen.hs | 1 + tools/canonicalize-proto-file/Main.hs | 8 +-- 13 files changed, 124 insertions(+), 52 deletions(-) create mode 100644 test-files/test_proto_empty_field.proto create mode 100644 tests/Test/Proto/Parse.hs create mode 100644 tests/Test/Proto/Parse/Core.hs diff --git a/proto3-suite.cabal b/proto3-suite.cabal index ed031216..75c8952f 100644 --- a/proto3-suite.cabal +++ b/proto3-suite.cabal @@ -49,7 +49,7 @@ source-repository head common common default-extensions: - DeriveDataTypeable DeriveGeneric + BlockArguments DeriveDataTypeable DeriveGeneric ImportQualifiedPost library import: common @@ -186,6 +186,8 @@ test-suite tests --TestProtoProtocPlugin Test.Proto.Generate.Name Test.Proto.Generate.Name.Gen + Test.Proto.Parse + Test.Proto.Parse.Core Test.Proto.Parse.Gen Test.Proto.Parse.Option diff --git a/shell.nix b/shell.nix index d5a55d89..22fdf55c 100644 --- a/shell.nix +++ b/shell.nix @@ -28,6 +28,7 @@ let in proto3-suite.env.overrideAttrs (old: { buildInputs = (old.buildInputs or []) ++ [ pkgs.cabal-install + pkgs.protobuf pkgs.python3Packages.virtualenv ]; }) diff --git a/src/Proto3/Suite/DotProto/AST.hs b/src/Proto3/Suite/DotProto/AST.hs index e854cbc5..056d3d50 100644 --- a/src/Proto3/Suite/DotProto/AST.hs +++ b/src/Proto3/Suite/DotProto/AST.hs @@ -286,7 +286,6 @@ type DotProtoEnumValue = Int32 data DotProtoEnumPart = DotProtoEnumField DotProtoIdentifier DotProtoEnumValue [DotProtoOption] | DotProtoEnumOption DotProtoOption - | DotProtoEnumEmpty deriving (Data, Eq, Generic, Ord, Show) instance Arbitrary DotProtoEnumPart where diff --git a/src/Proto3/Suite/DotProto/Parsing.hs b/src/Proto3/Suite/DotProto/Parsing.hs index a8cd4474..48cfd4f7 100644 --- a/src/Proto3/Suite/DotProto/Parsing.hs +++ b/src/Proto3/Suite/DotProto/Parsing.hs @@ -1,6 +1,7 @@ -- | This module contains a near-direct translation of the proto3 grammar -- It uses String for easier compatibility with DotProto.Generator, which needs it for not very good reasons +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} @@ -26,6 +27,9 @@ module Proto3.Suite.DotProto.Parsing -- * Extension Parsers , pExtendStmt , pExtendKw + + -- * Empty Statement + , pEmptyStmt ) where import Prelude hiding (fail) @@ -38,6 +42,7 @@ import Control.Monad (fail) import Control.Monad.Fail #endif import qualified Data.Char as Char +import Data.Maybe (catMaybes) import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.List.NonEmpty as NE import Data.Functor @@ -302,7 +307,7 @@ definition :: ProtoParser DotProtoDefinition definition = choice [ try message - , try enum + , try pEnumDefn , service ] @@ -411,10 +416,13 @@ service = do symbol "service" -- message definitions message :: ProtoParser DotProtoDefinition -message = do symbol "message" - name <- singleIdentifier - body <- braces (many messagePart) - return $ DotProtoMessage mempty name body +message = do + symbol "message" + name <- singleIdentifier + body <- braces do + results <- many messagePart + pure (catMaybes results) + pure (DotProtoMessage mempty name body) messageOneOf :: ProtoParser DotProtoMessagePart messageOneOf = do symbol "oneof" @@ -422,13 +430,15 @@ messageOneOf = do symbol "oneof" body <- braces (many messageField) return $ DotProtoMessageOneOf name body -messagePart :: ProtoParser DotProtoMessagePart -messagePart = try (DotProtoMessageDefinition <$> enum) - <|> try (DotProtoMessageReserved <$> reservedField) - <|> try (DotProtoMessageDefinition <$> message) - <|> try messageOneOf - <|> try (DotProtoMessageField <$> messageField) - <|> try (DotProtoMessageOption <$> pOptionStmt) +messagePart :: ProtoParser (Maybe DotProtoMessagePart) +messagePart = + try (Just . DotProtoMessageDefinition <$> pEnumDefn) + <|> try (Just . DotProtoMessageReserved <$> reservedField) + <|> try (Just . DotProtoMessageDefinition <$> message) + <|> try (fmap Just messageOneOf) + <|> try (Just . DotProtoMessageField <$> messageField) + <|> try (Just . DotProtoMessageOption <$> pOptionStmt) + <|> (Nothing <$ pEmptyStmt) messageType :: ProtoParser DotProtoType messageType = try mapType <|> try repType <|> (Prim <$> primType) @@ -461,16 +471,20 @@ enumField = do fname <- identifier return $ DotProtoEnumField fname fpos opts -enumStatement :: ProtoParser DotProtoEnumPart -enumStatement = try (DotProtoEnumOption <$> pOptionStmt) - <|> enumField - <|> empty $> DotProtoEnumEmpty +enumStatement :: ProtoParser (Maybe DotProtoEnumPart) +enumStatement = + try (fmap (Just . DotProtoEnumOption) pOptionStmt) + <|> try (fmap Just enumField) + <|> (Nothing <$ pEmptyStmt) -enum :: ProtoParser DotProtoDefinition -enum = do symbol "enum" - ename <- singleIdentifier - ebody <- braces (many enumStatement) - return $ DotProtoEnum mempty ename ebody +pEnumDefn :: ProtoParser DotProtoDefinition +pEnumDefn = do + symbol "enum" + ename <- singleIdentifier + ebody <- braces do + results <- many enumStatement + pure (catMaybes results) + pure (DotProtoEnum mempty ename ebody) -------------------------------------------------------------------------------- -- field reservations @@ -502,7 +516,9 @@ pExtendStmt :: ProtoParser (DotProtoIdentifier, [DotProtoMessagePart]) pExtendStmt = do pExtendKw idt <- identifier - fxs <- braces (many messagePart) + fxs <- braces do + results <- many messagePart + pure (catMaybes results) pure (idt, fxs) -- | Parses a single keyword token "extend". @@ -513,3 +529,11 @@ pExtendKw = do spaces token (string "extend" >> notFollowedBy alphaNum) "keyword 'extend'" + +-- Parse - Empty Statements ---------------------------------------------------- + +-- | Parses a single empty statement (i.e. a semicolon). +-- +-- See: https://protobuf.dev/reference/protobuf/proto3-spec/#emptystatement +pEmptyStmt :: ProtoParser () +pEmptyStmt = token (() <$ char ';') "empty statement" \ No newline at end of file diff --git a/src/Proto3/Suite/DotProto/Rendering.hs b/src/Proto3/Suite/DotProto/Rendering.hs index f9df0ccc..2f421788 100644 --- a/src/Proto3/Suite/DotProto/Rendering.hs +++ b/src/Proto3/Suite/DotProto/Rendering.hs @@ -157,8 +157,6 @@ prettyPrintProtoDefinition opts = defn where <> PP.text ";" enumPart _ (DotProtoEnumOption opt) = PP.text "option" <+> pPrint opt <> PP.text ";" - enumPart _ DotProtoEnumEmpty - = PP.empty instance Pretty DotProtoServicePart where pPrint (DotProtoServiceRPCMethod RPCMethod{..}) diff --git a/test-files/test_proto_empty_field.proto b/test-files/test_proto_empty_field.proto new file mode 100644 index 00000000..77eb2514 --- /dev/null +++ b/test-files/test_proto_empty_field.proto @@ -0,0 +1,15 @@ + +syntax = "proto3"; +package TestProtoEmptyFeild; + +enum EnumWithEmptyField { + enum_foo = 0; + ; + enum_bar = 1; +} + +message MessageWithEmptyField { + uint32 foo = 1; + ; + uint32 bar = 2; +} diff --git a/tests/Main.hs b/tests/Main.hs index 1a0d90d3..d35ceb89 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -54,8 +54,8 @@ tests logger = testGroup "Tests" , parserUnitTests , dotProtoUnitTests , codeGenTests logger - , Test.Proto.Generate.Name.tests - , Test.Proto.Parse.Option.tests + , Test.Proto.Generate.Name.testTree + , Test.Proto.Parse.Option.testTree #ifdef DHALL , dhallTests diff --git a/tests/Test/Proto/Generate/Name.hs b/tests/Test/Proto/Generate/Name.hs index a70e5341..a8b16942 100644 --- a/tests/Test/Proto/Generate/Name.hs +++ b/tests/Test/Proto/Generate/Name.hs @@ -4,7 +4,7 @@ -- | -- -module Test.Proto.Generate.Name (tests) where +module Test.Proto.Generate.Name (testTree) where import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testProperty) @@ -20,8 +20,8 @@ import Proto3.Suite.DotProto.Generate -- ----------------------------------------------------------------------------- -tests :: TestTree -tests = +testTree :: TestTree +testTree = testGroup "Test.Proto.Generate.Name" [ testProperty "filenames" resolve'protofile diff --git a/tests/Test/Proto/Parse.hs b/tests/Test/Proto/Parse.hs new file mode 100644 index 00000000..6e70823d --- /dev/null +++ b/tests/Test/Proto/Parse.hs @@ -0,0 +1,21 @@ + +module Test.Proto.Parse (testTree) where + +import Hedgehog (property, (===)) + +import Proto3.Suite.DotProto.Parsing qualified as Proto3 +import Proto3.Suite.DotProto.Rendering () + +import Test.Proto.Parse.Core (runParseTest) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.Hedgehog (testProperty) + +-------------------------------------------------------------------------------- + +testTree :: TestTree +testTree = + testGroup + "Test.Proto.Parse" + [ testProperty "empty" $ property do + runParseTest Proto3.pEmptyStmt ";" === Right () + ] \ No newline at end of file diff --git a/tests/Test/Proto/Parse/Core.hs b/tests/Test/Proto/Parse/Core.hs new file mode 100644 index 00000000..687d2391 --- /dev/null +++ b/tests/Test/Proto/Parse/Core.hs @@ -0,0 +1,24 @@ + +module Test.Proto.Parse.Core + ( runParseTest + , parseTrip + ) where + +import Hedgehog (PropertyT) +import Hedgehog qualified as Hedgehog + +import Text.Parsec (ParseError) +import Text.Parsec qualified as Parsec +import Text.PrettyPrint (render) +import Text.PrettyPrint.HughesPJClass (Pretty, pPrint) + +import Proto3.Suite.DotProto.Parsing (ProtoParser) +import Proto3.Suite.DotProto.Parsing qualified as Proto3 + +-------------------------------------------------------------------------------- + +runParseTest :: ProtoParser a -> String -> Either ParseError a +runParseTest p = Parsec.parse (Proto3.runProtoParser p) "" + +parseTrip :: (Eq a, Pretty a, Show a) => a -> ProtoParser a -> PropertyT IO () +parseTrip x p = Hedgehog.tripping x (render . pPrint) (runParseTest p) diff --git a/tests/Test/Proto/Parse/Option.hs b/tests/Test/Proto/Parse/Option.hs index 7d4261d8..6bd90289 100644 --- a/tests/Test/Proto/Parse/Option.hs +++ b/tests/Test/Proto/Parse/Option.hs @@ -1,27 +1,26 @@ -module Test.Proto.Parse.Option (tests) where +module Test.Proto.Parse.Option (testTree) where -import Hedgehog (Property, PropertyT, forAll, property, (===)) +import Hedgehog (Property, forAll, property, (===)) import qualified Hedgehog as Hedgehog import qualified Hedgehog.Gen as Gen import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testProperty) +import Test.Proto.Parse.Core (runParseTest, parseTrip) import qualified Test.Proto.Parse.Gen as Gen import qualified Data.Char as Char import Data.Either (isLeft) import Text.Parsec (ParseError) -import qualified Text.Parsec as Parsec -import Text.PrettyPrint (render) -import Text.PrettyPrint.HughesPJClass (Pretty, pPrint) -import Proto3.Suite.DotProto.Parsing (ProtoParser) import qualified Proto3.Suite.DotProto.Parsing as Proto3 import Proto3.Suite.DotProto.Rendering () -- orphan Pretty DotProtoIdentifier -tests :: TestTree -tests = +-------------------------------------------------------------------------------- + +testTree :: TestTree +testTree = testGroup "Test.Proto.Parse.Option" [ testProperty "Unqualified Option Identifier" propParseName @@ -30,12 +29,6 @@ tests = , testsOptionKw ] -runParseTest :: ProtoParser a -> String -> Either ParseError a -runParseTest p = Parsec.parse (Proto3.runProtoParser p) "" - -parseTrip :: (Eq a, Pretty a, Show a) => a -> ProtoParser a -> PropertyT IO () -parseTrip x p = Hedgehog.tripping x (render . pPrint) (runParseTest p) - propParseName :: Property propParseName = property $ do idt <- forAll Gen.optionName diff --git a/tests/TestCodeGen.hs b/tests/TestCodeGen.hs index af9a0247..db94a012 100644 --- a/tests/TestCodeGen.hs +++ b/tests/TestCodeGen.hs @@ -254,6 +254,7 @@ compileTestDotProtos logger recStyle decodedStringType = do let protoFiles :: [Turtle.FilePath] protoFiles = [ "test_proto.proto" + , "test_proto_empty_field.proto" , "test_proto_import.proto" , "test_proto_oneof.proto" , "test_proto_oneof_import.proto" diff --git a/tools/canonicalize-proto-file/Main.hs b/tools/canonicalize-proto-file/Main.hs index 0448c954..63be550a 100644 --- a/tools/canonicalize-proto-file/Main.hs +++ b/tools/canonicalize-proto-file/Main.hs @@ -187,17 +187,13 @@ instance Canonicalize [DotProtoReservedField] where | otherwise = FieldRange lo hi instance Canonicalize [DotProtoEnumPart] where - canonicalize = canonicalSort . filter keep - where - keep DotProtoEnumEmpty = False - keep _ = True + canonicalize = canonicalSort instance CanonicalRank DotProtoEnumPart (Either (Maybe DotProtoOption) DotProtoEnumValue) where canonicalRank = \case DotProtoEnumField _ value _ -> Right value DotProtoEnumOption option -> Left (Just option) - DotProtoEnumEmpty -> Left Nothing instance Canonicalize DotProtoEnumPart where canonicalize = \case @@ -205,8 +201,6 @@ instance Canonicalize DotProtoEnumPart where DotProtoEnumField (canonicalize name) value (map canonicalize opts) DotProtoEnumOption option -> DotProtoEnumOption (canonicalize option) - DotProtoEnumEmpty -> - DotProtoEnumEmpty instance Canonicalize [DotProtoServicePart] where canonicalize = canonicalSort . filter keep From be005bb300a16c3a6504298d1acb8b71bd7e7904 Mon Sep 17 00:00:00 2001 From: Jacob Leach Date: Wed, 13 Nov 2024 13:40:04 -0600 Subject: [PATCH 2/5] refact: remove empty constructor for `DotProtoServicePart` --- src/Proto3/Suite/DotProto/AST.hs | 1 - src/Proto3/Suite/DotProto/Parsing.hs | 20 ++++++++++++-------- src/Proto3/Suite/DotProto/Rendering.hs | 1 - tools/canonicalize-proto-file/Main.hs | 8 +------- 4 files changed, 13 insertions(+), 17 deletions(-) diff --git a/src/Proto3/Suite/DotProto/AST.hs b/src/Proto3/Suite/DotProto/AST.hs index 056d3d50..9711f2ac 100644 --- a/src/Proto3/Suite/DotProto/AST.hs +++ b/src/Proto3/Suite/DotProto/AST.hs @@ -312,7 +312,6 @@ instance Arbitrary Streaming where data DotProtoServicePart = DotProtoServiceRPCMethod RPCMethod | DotProtoServiceOption DotProtoOption - | DotProtoServiceEmpty deriving (Data, Eq, Generic, Ord, Show) instance Arbitrary DotProtoServicePart where diff --git a/src/Proto3/Suite/DotProto/Parsing.hs b/src/Proto3/Suite/DotProto/Parsing.hs index 48cfd4f7..b182d15e 100644 --- a/src/Proto3/Suite/DotProto/Parsing.hs +++ b/src/Proto3/Suite/DotProto/Parsing.hs @@ -383,10 +383,11 @@ pOptionKw = do -------------------------------------------------------------------------------- -- service statements -servicePart :: ProtoParser DotProtoServicePart -servicePart = DotProtoServiceRPCMethod <$> rpc - <|> DotProtoServiceOption <$> pOptionStmt - <|> DotProtoServiceEmpty <$ empty +servicePart :: ProtoParser (Maybe DotProtoServicePart) +servicePart = + (fmap (Just . DotProtoServiceRPCMethod) rpc) + <|> (fmap (Just . DotProtoServiceOption) pOptionStmt) + <|> Nothing <$ pEmptyStmt rpcOptions :: ProtoParser [DotProtoOption] rpcOptions = braces $ many pOptionStmt @@ -407,10 +408,13 @@ rpc = do symbol "rpc" return RPCMethod{..} service :: ProtoParser DotProtoDefinition -service = do symbol "service" - name <- singleIdentifier - statements <- braces (many servicePart) - return $ DotProtoService mempty name statements +service = do + symbol "service" + name <- singleIdentifier + statements <- braces do + results <- many servicePart + pure (catMaybes results) + return $ DotProtoService mempty name statements -------------------------------------------------------------------------------- -- message definitions diff --git a/src/Proto3/Suite/DotProto/Rendering.hs b/src/Proto3/Suite/DotProto/Rendering.hs index 2f421788..9c6528a1 100644 --- a/src/Proto3/Suite/DotProto/Rendering.hs +++ b/src/Proto3/Suite/DotProto/Rendering.hs @@ -169,7 +169,6 @@ instance Pretty DotProtoServicePart where [] -> PP.text ";" _ -> PP.braces . PP.vcat $ topOption <$> rpcMethodOptions pPrint (DotProtoServiceOption option) = topOption option - pPrint DotProtoServiceEmpty = PP.empty instance Pretty Streaming where pPrint Streaming = PP.text "stream" diff --git a/tools/canonicalize-proto-file/Main.hs b/tools/canonicalize-proto-file/Main.hs index 63be550a..e97d34a5 100644 --- a/tools/canonicalize-proto-file/Main.hs +++ b/tools/canonicalize-proto-file/Main.hs @@ -203,17 +203,13 @@ instance Canonicalize DotProtoEnumPart where DotProtoEnumOption (canonicalize option) instance Canonicalize [DotProtoServicePart] where - canonicalize = canonicalSort . filter keep - where - keep DotProtoServiceEmpty = False - keep _ = True + canonicalize = canonicalSort instance CanonicalRank DotProtoServicePart (Either (Maybe DotProtoOption) DotProtoIdentifier) where canonicalRank = \case DotProtoServiceRPCMethod method -> Right (rpcMethodName method) DotProtoServiceOption option -> Left (Just option) - DotProtoServiceEmpty -> Left Nothing instance Canonicalize DotProtoServicePart where canonicalize = \case @@ -221,8 +217,6 @@ instance Canonicalize DotProtoServicePart where DotProtoServiceRPCMethod (canonicalize guts) DotProtoServiceOption option -> DotProtoServiceOption (canonicalize option) - DotProtoServiceEmpty -> - DotProtoServiceEmpty instance Canonicalize RPCMethod where canonicalize (RPCMethod name reqN reqS rspN rspS options) = From ea0775fa11c6f3072de2a4fe3b95eb377a75b314 Mon Sep 17 00:00:00 2001 From: Jacob Leach Date: Thu, 14 Nov 2024 12:12:50 -0600 Subject: [PATCH 3/5] fix: spelling error --- test-files/test_proto_empty_field.proto | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test-files/test_proto_empty_field.proto b/test-files/test_proto_empty_field.proto index 77eb2514..a81d1e09 100644 --- a/test-files/test_proto_empty_field.proto +++ b/test-files/test_proto_empty_field.proto @@ -1,6 +1,6 @@ syntax = "proto3"; -package TestProtoEmptyFeild; +package TestProtoEmptyField; enum EnumWithEmptyField { enum_foo = 0; From aee7c45ab2051698fdf7cb18b63b201ba35e6c55 Mon Sep 17 00:00:00 2001 From: Jacob Leach Date: Thu, 14 Nov 2024 12:13:04 -0600 Subject: [PATCH 4/5] fix: add `try` to service part parsers --- src/Proto3/Suite/DotProto/Parsing.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Proto3/Suite/DotProto/Parsing.hs b/src/Proto3/Suite/DotProto/Parsing.hs index b182d15e..ce554c3c 100644 --- a/src/Proto3/Suite/DotProto/Parsing.hs +++ b/src/Proto3/Suite/DotProto/Parsing.hs @@ -385,8 +385,8 @@ pOptionKw = do servicePart :: ProtoParser (Maybe DotProtoServicePart) servicePart = - (fmap (Just . DotProtoServiceRPCMethod) rpc) - <|> (fmap (Just . DotProtoServiceOption) pOptionStmt) + try (fmap (Just . DotProtoServiceRPCMethod) rpc) + <|> try (fmap (Just . DotProtoServiceOption) pOptionStmt) <|> Nothing <$ pEmptyStmt rpcOptions :: ProtoParser [DotProtoOption] From f751d5e0f8e419fd72e782a8a3c3bbaa95314c45 Mon Sep 17 00:00:00 2001 From: Jacob Leach Date: Thu, 14 Nov 2024 13:23:31 -0600 Subject: [PATCH 5/5] add: tests on parsing empty statements --- tests/Main.hs | 39 +++++++++++++++++++++++++++++++++++++++ tests/TestCodeGen.hs | 1 - 2 files changed, 39 insertions(+), 1 deletion(-) diff --git a/tests/Main.hs b/tests/Main.hs index d35ceb89..462c2a9d 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -269,6 +269,7 @@ dotProtoUnitTests :: TestTree dotProtoUnitTests = testGroup ".proto parsing tests" [ dotProtoParseTrivial , dotProtoPrintTrivial + , dotProtoParseEmptyStatement , dotProtoRoundtripTrivial , dotProtoRoundtripSimpleMessage , dotProtoRoundtripExtend @@ -288,6 +289,44 @@ dotProtoPrintTrivial = testCase "Print a content-less DotProto" $ testDotProtoPrint trivialDotProto "syntax = \"proto3\";" +dotProtoParseEmptyStatement :: TestTree +dotProtoParseEmptyStatement = + testCase "Parse empty statements" (testDotProtoParse filePath dotProtoAST) + where + filePath :: FilePath + filePath = testFilesPfx <> "test_proto_empty_field.proto" + + dotProtoAST :: DotProto + dotProtoAST = + DotProto [] [] + (DotProtoPackageSpec (Single "TestProtoEmptyField")) + [ DotProtoEnum + "" + (Single "EnumWithEmptyField") + [ DotProtoEnumField (Single "enum_foo") 0 [] + , DotProtoEnumField (Single "enum_bar") 1 [] + ] + , DotProtoMessage + "" + (Single "MessageWithEmptyField") + [ DotProtoMessageField (DotProtoField + { dotProtoFieldNumber = 1 + , dotProtoFieldType = Prim UInt32 + , dotProtoFieldName = Single "foo" + , dotProtoFieldOptions = [] + , dotProtoFieldComment = "" + }) + , DotProtoMessageField (DotProtoField + { dotProtoFieldNumber = 2 + , dotProtoFieldType = Prim UInt32 + , dotProtoFieldName = Single "bar" + , dotProtoFieldOptions = [] + , dotProtoFieldComment = "" + }) + ] + ] + (DotProtoMeta (Path (testFilesPfx NE.:| ["test_proto_empty_field.proto"]))) + dotProtoRoundtripTrivial :: TestTree dotProtoRoundtripTrivial = testCase "Printing then parsing a content-less DotProto yields an empty DotProto" $ diff --git a/tests/TestCodeGen.hs b/tests/TestCodeGen.hs index db94a012..af9a0247 100644 --- a/tests/TestCodeGen.hs +++ b/tests/TestCodeGen.hs @@ -254,7 +254,6 @@ compileTestDotProtos logger recStyle decodedStringType = do let protoFiles :: [Turtle.FilePath] protoFiles = [ "test_proto.proto" - , "test_proto_empty_field.proto" , "test_proto_import.proto" , "test_proto_oneof.proto" , "test_proto_oneof_import.proto"