* Alias support

packages/fcl-yaml/src/fpyaml.parser.pp

@@ -248,7 +248,11 @@ var
 begin
   lToken:=Peek;
   case lToken.Token of
-    ytAnchor : ParseAnchor;
+    ytAnchor :
+      begin
+      ParseAnchor;
+      Result:=ParseValue(aAllowBlockEntry);
+      end;
     ytAlias : Result:=ParseAlias;
     ytBlockEntry :
       {
@@ -415,9 +419,21 @@ end;
 
 
 function TYAMLParser.ParseAlias : TYAMLData;
+// On entry, we're on the alias token.
+// On exit, we're on EOF or the first token after the alias token.
+var
+  lToken : TYAMLTokenData;
+  lAlias : TYAMLString;
+  lValue : TYAMLData;
 
 begin
-  //
+  lToken:=Peek;
+  lAlias:=lToken.Value;
+  ConsumeToken;
+  lValue:=TYAMLData(FMap.Items[lAlias]);
+  if lValue=nil then
+    Error(SErrUnknownAlias,[lAlias]);
+  Result:=lValue.Clone;
 end;
 
 

packages/fcl-yaml/src/fpyaml.strings.pp

@@ -62,6 +62,7 @@ resourcestring
   SErrDoubleVersion   = 'Double version directive: encountered new version "%s", current is "%s".';
   SErrAliasNotAllowed = 'Alias not allowed at stream level.';
   SErrUnexpectedToken = 'Unexpected token %s with value: "%s".';
+  SErrUnknownAlias    = 'Unknown alias: "%s".';
 
   // Convert to JSON
   SErrOnlyScalarKeys = 'Only scalar keys can be converted to JSON keys.';

packages/fcl-yaml/test/utyamldata.pp

@@ -32,7 +32,9 @@ Type
   Public
     procedure TearDown; override;
     procedure SetData(aData : TYAMLData);
-    procedure AssertScalar(const Msg : string; aData : TYAMLData; aType : TYAMLTagType; const aValue : String);
+    function AssertScalar(const Msg : string; aData : TYAMLData; aType : TYAMLTagType; const aValue : String) : TYAMLScalar;
+    function AssertMapping(Msg: String; Y: TYAMLData; aCount : Integer = -1): TYAMLMapping;
+    function AssertSequence(Msg: String; Y: TYAMLData; aCount : Integer = -1): TYAMLSequence;
     Property Data : TYAMLData Read FData Write SetData;
   Published
     Procedure TestHookup;
@@ -156,12 +158,33 @@ begin
   FData:=aData;
 end;
 
-procedure TTestYAMLData.AssertScalar(const Msg: string; aData: TYAMLData; aType: TYAMLTagType; const aValue: String);
+function TTestYAMLData.AssertScalar(const Msg: string; aData: TYAMLData; aType: TYAMLTagType; const aValue: String): TYAMLScalar;
 begin
   AssertNotNull(Msg+': not null',aData);
   AssertEquals(Msg+': scalar',TYAMLScalar,aData.ClassType);
   AssertEquals(Msg+': tag',YAMLTagNames[aType],aData.Tag);
   AssertEquals(Msg+': value',aValue,TYAMLScalar(aData).Value);
+  Result:=TYAMLScalar(aData);
+end;
+
+function TTestYamlData.AssertSequence(Msg: String; Y: TYAMLData; aCount: Integer = -1): TYAMLSequence;
+
+begin
+  AssertNotNull(Msg+': Have data',Y);
+  AssertEquals(Msg+': Have sequence',TYAMLSequence,Y.ClassType);
+  if aCount<>-1 then
+    AssertEquals(Msg+': element count',aCount,Y.Count);
+  Result:=TYAMLSequence(Y);
+end;
+
+Function TTestYamlData.AssertMapping(Msg : String; Y : TYAMLData; aCount : Integer = -1) : TYAMLMapping;
+
+begin
+  AssertNotNull(Msg+': Have data',Y);
+  AssertEquals(Msg+': Have mapping',TYAMLMapping,Y.ClassType);
+  if aCount<>-1 then
+    AssertEquals(Msg+': element count',aCount,Y.Count);
+  Result:=TYAMLMapping(Y);
 end;
 
 procedure TTestYAMLData.TestHookup;

packages/fcl-yaml/test/utyamlparser.pp

@@ -28,8 +28,6 @@ type
   TTestYamlParser= class(TTestYAMLData)
   private
     FParser: TYAMLParser;
-    function AssertMapping(Msg: String; Y: TYAMLData): TYAMLMapping;
-    function AssertSequence(Msg: String; Y: TYAMLData): TYAMLSequence;
     function AssertValue(aClass: TYAMLDataClass): TYAMLData;
     function GetDocument: TYAMLDocument;
     function GetStream: TYAMLStream;
@@ -51,6 +49,7 @@ type
     procedure TestMultiDocumentNoEnd;
     procedure TestScalar;
     procedure TestAnchoredScalar;
+    procedure TestAlias;
     procedure TestBlockSequence;
     procedure TestBlockSequenceTwo;
     procedure TestBlockSequenceThree;
@@ -107,12 +106,27 @@ begin
   AssertEquals('YAML Stream',TYAMLStream,Data.ClassType);
   AssertEquals('YAML Stream item count',1,YAML.Count);
   AssertNotNull('Document',Document);
-  AssertNotNUll('Value');
+  AssertScalar('Value',Value,yttString,'one');
+  AssertNotNUll('Value',Value);
   AssertEquals('Value ',TYAMLScalar,Value.ClassType);
-  AssertEquals('Value ','one',Value.AsString);
+  AssertEquals('Value valua ','one',Value.AsString);
   AssertEquals('Value ','anchor',Value.Anchor);
 end;
 
+procedure TTestYamlParser.TestAlias;
+
+var
+  Seq : TYAMLSequence;
+  lItem : TYAMLScalar;
+begin
+  Parse(['- &anchor one','- *anchor ']);
+  Seq:=AssertSequence('Value',Value,2);
+  lItem:=AssertScalar('First',Seq[0],yttString,'one');
+  AssertEquals('first has anchor','anchor',lItem.Anchor);
+  lItem:=AssertScalar('Second',Seq[1],yttString,'one');
+  AssertEquals('second has no anchor','',lItem.Anchor);
+end;
+
 function TTestYamlParser.AssertValue(aClass : TYAMLDataClass) : TYAMLData;
 
 begin
@@ -370,20 +384,6 @@ begin
   AssertScalar('2 - item',map.items[1],yttString,'c');
 end;
 
-Function TTestYamlParser.AssertSequence(Msg : String; Y : TYAMLData) : TYAMLSequence;
-begin
-  AssertNotNull(Msg+': Have data',Y);
-  AssertEquals(Msg+': Have sequence',TYAMLSequence,Y.ClassType);
-  Result:=TYAMLSequence(Y);
-end;
-Function TTestYamlParser.AssertMapping(Msg : String; Y : TYAMLData) : TYAMLMapping;
-
-begin
-  AssertNotNull(Msg+': Have data',Y);
-  AssertEquals(Msg+': Have mapping',TYAMLMapping,Y.ClassType);
-  Result:=TYAMLMapping(Y);
-
-end;
 
 procedure TTestYamlParser.TestBlockMappingUnindentedSequenceWithIndent;
 var