Parcourir la source

* Add possibility to scan single document in consecutive calls

Michaël Van Canneyt il y a 7 mois
Parent
commit
2b56b2d725
2 fichiers modifiés avec 80 ajouts et 24 suppressions
  1. 52 22
      packages/fcl-yaml/src/fpyaml.parser.pp
  2. 28 2
      packages/fcl-yaml/test/utyamlparser.pp

+ 52 - 22
packages/fcl-yaml/src/fpyaml.parser.pp

@@ -67,8 +67,9 @@ Type
     function ParseBlockSequence(SkipStart: boolean=false): TYAMLSequence; virtual;
     function ParseFlowSequence: TYAMLSequence; virtual;
     function ParseValue(aAllowBlockEntry: Boolean=false): TYAMLData; virtual;
-    function ParseDocument: TYAMLDocument; virtual;
     function ParseTagDirective: TYAMLTagData; virtual;
+    function ParseDocument: TYAMLDocument; virtual;
+    function ParseSingleDocument(aStream: TYAMLStream): TYAMLDocument;
     Property Scanner : TYAMLScanner Read FScanner;
   public
     Constructor Create(aScanner : TYAMLScanner; aOwnsScanner : Boolean = False);
@@ -77,6 +78,7 @@ Type
     Constructor Create(const aInput : array of string);
     Constructor Create(const aFileName : string);
     Destructor Destroy; override;
+    function ParseSingleDocument: TYAMLDocument;
     Function Parse : TYAMLStream;
   end;
 
@@ -588,7 +590,7 @@ end;
 function TYAMLParser.Parse: TYAMLStream;
 
 var
-  lToken : TYAMLTokenData;
+  lDoc : TYAMLDocument;
   lDone : Boolean;
 
 begin
@@ -596,26 +598,10 @@ begin
   Result:=CreateStream;
   try
     Repeat
-      lToken:=Peek;
-      Case lToken.token of
-        ytAnchor : ParseAnchor;
-        ytAlias : Error(SErrAliasNotAllowed);
-        ytScalarDouble,
-        ytScalarSingle,
-        ytScalarFolded,
-        ytScalarLiteral,
-        ytScalarPlain,
-        ytBlockMappingStart,
-        ytBlockSequenceStart,
-        ytFlowSequenceStart,
-        ytFlowMappingStart,
-        ytDocumentStart : Result.Add(ParseDocument);
-        ytVersionDirective : ParseVersion;
-        ytTagDirective : Result.Add(ParseTagDirective);
-        ytEOF: lDone:=True;
-      else
-        Error(SErrUnexpectedToken,[lToken.Token.ToString,lToken.value]);
-      end;
+      lDoc:=ParseSingleDocument(Result);
+      lDone:=lDoc=Nil;
+      if not lDone then
+        Result.Add(lDoc);
     until lDone;
   except
     Result.Free;
@@ -634,5 +620,49 @@ begin
   inherited Destroy;
 end;
 
+function TYAMLParser.ParseSingleDocument: TYAMLDocument;
+begin
+  Result:=ParseSingleDocument(Nil);
+end;
+
+function TYAMLParser.ParseSingleDocument(aStream : TYAMLStream): TYAMLDocument;
+
+var
+  lToken : TYAMLTokenData;
+  lTag : TYAMLTagData;
+
+begin
+  Result:=Nil;
+  Repeat
+    lToken:=Peek;
+    Case lToken.token of
+      ytAnchor : ParseAnchor;
+      ytAlias : Error(SErrAliasNotAllowed);
+      ytScalarDouble,
+      ytScalarSingle,
+      ytScalarFolded,
+      ytScalarLiteral,
+      ytScalarPlain,
+      ytBlockMappingStart,
+      ytBlockSequenceStart,
+      ytFlowSequenceStart,
+      ytFlowMappingStart,
+      ytDocumentStart : Result:=ParseDocument;
+      ytVersionDirective : ParseVersion;
+      ytTagDirective :
+        begin
+        lTag:=ParseTagDirective;
+        if aStream<>Nil then
+          aStream.Add(lTag)
+        else
+          lTag.Free;
+        end;
+      ytEOF: ;
+    else
+      Error(SErrUnexpectedToken,[lToken.Token.ToString,lToken.value]);
+    end;
+  until (lToken.token=ytEOF) or Assigned(Result);
+end;
+
 end.
 

+ 28 - 2
packages/fcl-yaml/test/utyamlparser.pp

@@ -28,13 +28,13 @@ type
   TTestYamlParser= class(TTestYAMLData)
   private
     FParser: TYAMLParser;
+    FSingle : Boolean;
     function AssertValue(aClass: TYAMLDataClass): TYAMLData;
     function GetDocument: TYAMLDocument;
     function GetStream: TYAMLStream;
     function GetValue: TYAMLData;
   public
     procedure Parse(aContent : Array of string);
-
     procedure SetUp; override;
     procedure TearDown; override;
     property Parser : TYAMLParser Read FParser;
@@ -47,6 +47,7 @@ type
     procedure TestVersionEmptyDocument;
     procedure TestMultiDocument;
     procedure TestMultiDocumentNoEnd;
+    procedure TestMultiDocumentSingle;
     procedure TestScalar;
     procedure TestAnchoredScalar;
     procedure TestAlias;
@@ -548,6 +549,28 @@ begin
   AssertScalar('Document 2 element',Doc[0],yttString,'def');
 end;
 
+procedure TTestYamlParser.TestMultiDocumentSingle;
+var
+  doc : TYAMLDocument;
+begin
+  FSingle:=True;
+  Parse(['%YAML 1.2','---','abc','...','---','def','...']);
+  AssertNotNull('Data',Data);
+  AssertEquals('YAML Stream',TYAMLDocument,Data.ClassType);
+  Doc:=TYAMLDocument(Data);
+  AssertNotNull('Document 1',Doc);
+  AssertEquals('Document 1 Major',1,Doc.Version.Major);
+  AssertEquals('Document 1 Minor',2,Doc.Version.Minor);
+  AssertEquals('Document 1 element count',1,Doc.Count);
+  AssertScalar('Document 1 element',Doc[0],yttString,'abc');
+  SetData(Parser.ParseSingleDocument);
+  AssertEquals('YAML Stream',TYAMLDocument,Data.ClassType);
+  Doc:=TYAMLDocument(Data);
+  AssertNotNull('Document 2',doc);
+  AssertEquals('Document 2 element count',1,Doc.Count);
+  AssertScalar('Document 2 element',Doc[0],yttString,'def');
+end;
+
 function TTestYamlParser.GetDocument: TYAMLDocument;
 
 begin
@@ -573,7 +596,10 @@ end;
 procedure TTestYamlParser.Parse(aContent: array of string);
 begin
   FParser:=TYAMLParser.Create(aContent);
-  SetData(FParser.Parse);
+  if FSingle then
+    SetData(FParser.ParseSingleDocument)
+  else
+    SetData(FParser.Parse);
 end;
 
 procedure TTestYamlParser.SetUp;