paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 17:39:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Alias support

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-12-31 13:12:07 +01:00
parent 349003662c
commit 417ba4cca8
4 changed files with 62 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
packages/fcl-yaml/src/fpyaml.parser.pp
View File

@ -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;

1
packages/fcl-yaml/src/fpyaml.strings.pp
View File

@ -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.';

27
packages/fcl-yaml/test/utyamldata.pp
View File

@ -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;

36
packages/fcl-yaml/test/utyamlparser.pp
View File

@ -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