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

* TTemplateParser: Do not require a space between the tag name and the

Browse Source 
ParamStartDelimiter. 
 * Allow parameters without any name, for example: {uppercase[-this-]}
 * Added simple tests for TTemplateParser

git-svn-id: trunk@20543 -
This commit is contained in:
joost 2012-03-20 16:13:14 +00:00
parent feb30b2e87
commit 0e0a5dee4f
4 changed files with 227 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -1809,6 +1809,8 @@ packages/fcl-base/src/win/fclel.res -text
packages/fcl-base/src/win/fileinfo.pp svneol=native#text/plain
packages/fcl-base/src/wince/fileinfo.pp svneol=native#text/plain
packages/fcl-base/src/wtex.pp svneol=native#text/plain
packages/fcl-base/tests/fclbase-unittests.pp svneol=native#text/plain
packages/fcl-base/tests/tests_fptemplate.pp svneol=native#text/plain
packages/fcl-base/texts/fptemplate.txt svneol=native#text/plain
packages/fcl-db/Makefile svneol=native#text/plain
packages/fcl-db/Makefile.fpc svneol=native#text/plain

26
packages/fcl-base/src/fptemplate.pp
View File

@ -410,6 +410,8 @@ begin
IsFirst := false;
I := 1;
while not (P[I] in [#0..' ']) do Inc(I);
if i>(TS-SP) then
i := TS-SP;
SetLength(TP, I);
Move(P^, TP[1], I);
end;
@ -423,16 +425,20 @@ begin
Move(TS^, PName[1], I);//param name
inc(TS, Length(FParamValueSeparator) + I);
I := TS - P;//index of param value
TE:=FindDelimiter(TS,FParamEndDelimiter, SLen-I+1);
if (TE<>Nil) then
begin//Found param end
I:=TE-TS;//Param length
Setlength(PValue,I);
Move(TS^,PValue[1],I);//Param value
end;
TE:=FindDelimiter(TS,FParamEndDelimiter, SLen-I+1);
if (TE<>Nil) then
begin//Found param end
I:=TE-TS;//Param length
Setlength(PValue,I);
Move(TS^,PValue[1],I);//Param value
if TM=nil then
TagParams.Add(Trim(PValue))
else
TagParams.Add(Trim(PName) + '=' + PValue);//Param names cannot contain '='
P:=TE+Length(FParamEndDelimiter);
TS:=P;
end else break;
P:=TE+Length(FParamEndDelimiter);
TS:=P;
end else break;
end else break;
end;
@ -472,6 +478,7 @@ begin
else
begin
I:=TS-P;
inc(TS,Length(FStartDelimiter));//points to first char of Tag name now
TE:=FindDelimiter(TS,FEndDelimiter,SLen-I+1);
If (TE=Nil) then
begin//Tag End Delimiter not found
@ -483,7 +490,6 @@ begin
// Add text prior to template tag to result
AddToString(Result,P,I);
// Retrieve the full template tag (only tag name if no params specified)
inc(TS,Length(FStartDelimiter));//points to first char of Tag name now
I:=TE-TS;//full Tag length
Setlength(PN,I);
Move(TS^,PN[1],I);//full Tag string (only tag name if no params specified)

17
packages/fcl-base/tests/fclbase-unittests.pp Normal file
View File

@ -0,0 +1,17 @@
program fclbase_unittests;
{$mode objfpc}{$H+}
uses
Classes, consoletestrunner, tests_fptemplate;
var
Application: TTestRunner;
begin
Application := TTestRunner.Create(nil);
Application.Initialize;
Application.Title := 'FCL-Base unittests';
Application.Run;
Application.Free;
end.

192
packages/fcl-base/tests/tests_fptemplate.pp Normal file
View File

@ -0,0 +1,192 @@
unit tests_fptemplate;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry;
type
{ TTestTemplateParser }
TTestTemplateParser= class(TTestCase)
private
Procedure TestAllowTagParamsBasics_replacetag(Sender : TObject; Const TagString : String; TagParams:TStringList; Out ReplaceText : String);
Procedure TestAllowTagParamsFunctionLike_replacetag(Sender : TObject; Const TagString : String; TagParams:TStringList; Out ReplaceText : String);
Procedure TestAllowTagParamsDelphiStyle_replacetag(Sender : TObject; Const TagString : String; TagParams:TStringList; Out ReplaceText : String);
published
procedure TestBasics;
procedure TestBasicDelimiters;
procedure TestAllowTagParamsBasics;
procedure TestAllowTagParamsFunctionLike;
procedure TestAllowTagParamsDelphiStyle;
end;
implementation
uses
fpTemplate;
procedure TTestTemplateParser.TestBasics;
var
templ: TTemplateParser;
begin
templ := TTemplateParser.Create;
try
templ.Values['dream'] := 'think';
templ.Values['test'] := 'template';
CheckEquals('This is the simplest template I could think of.',
templ.ParseString('This is the simplest {test} I could {dream} of.'));
templ.recursive := true;
templ.Values['val2'] := 'template';
templ.Values['test'] := '{val2} test';
CheckEquals('This is the simplest template test I could think of.',
templ.ParseString('This is the simplest {test} I could {dream} of.'));
finally
templ.free;
end;
end;
procedure TTestTemplateParser.TestBasicDelimiters;
var
templ: TTemplateParser;
begin
templ := TTemplateParser.Create;
try
templ.StartDelimiter:='[-';
templ.EndDelimiter:=')';
templ.Values['dream'] := 'think';
templ.Values['test'] := 'template';
CheckEquals('This is [the] simplest template I could think (of).',
templ.ParseString('This is [the] simplest [-test) I could [-dream) (of).'));
templ.StartDelimiter:='(';
templ.EndDelimiter:='-)';
templ.Values['dream'] := 'think';
templ.Values['test'] := 'template';
CheckEquals('This is [the] simplest template I could think of:-).',
templ.ParseString('This is [the] simplest (test-) I could (dream-) of:-).'));
finally
templ.free;
end;
end;
procedure TTestTemplateParser.TestAllowTagParamsBasics;
var
templ: TTemplateParser;
begin
templ := TTemplateParser.Create;
try
templ.AllowTagParams := true;
templ.OnReplaceTag := @TestAllowTagParamsBasics_replacetag;
CheckEquals('This is the simplest template I could think of.',
templ.ParseString('This is the simplest {test [- param1=test -]} I could {dream} of.'));
CheckEquals('This is the simplest template I could think of.',
templ.ParseString('This is the simplest {test[- param1=test -]} I could {dream} of.'));
templ.ParamValueSeparator:=':';
CheckEquals('This is the simplest template I could think of.',
templ.ParseString('This is the simplest {test [- param1:test -]} I could {dream} of.'));
CheckEquals('This is the simplest template I could think of.',
templ.ParseString('This is the simplest {test [-param1:test -]} I could {dream} of.'));
CheckEquals('This is the simplest template I could think of.',
templ.ParseString('This is the simplest {test [-param1:test -]} I could {dream} of.'));
finally
templ.free;
end;
end;
procedure TTestTemplateParser.TestAllowTagParamsFunctionLike;
var
templ: TTemplateParser;
begin
templ := TTemplateParser.Create;
try
templ.AllowTagParams := true;
templ.ParamStartDelimiter:='(';
templ.ParamEndDelimiter:=')';
templ.OnReplaceTag := @TestAllowTagParamsFunctionLike_replacetag;
CheckEquals('THIS should be uppercased.',
templ.ParseString('{uppercase(This)} should be uppercased.'));
finally
templ.free;
end;
end;
procedure TTestTemplateParser.TestAllowTagParamsDelphiStyle;
var
templ: TTemplateParser;
begin
templ := TTemplateParser.Create;
try
templ.AllowTagParams := true;
templ.StartDelimiter:='<#';
templ.EndDelimiter:='>';
templ.ParamStartDelimiter:=' ';
templ.ParamEndDelimiter:='"';
templ.ParamValueSeparator:='="';
templ.OnReplaceTag := @TestAllowTagParamsDelphiStyle_replacetag;
CheckEquals('Test for a Delphi parameter.',
templ.ParseString('Test for a <#DelphiTag param1="first param" param2="second param">.'));
finally
templ.free;
end;
end;
procedure TTestTemplateParser.TestAllowTagParamsBasics_replacetag(
Sender: TObject; const TagString: String; TagParams: TStringList; out
ReplaceText: String);
begin
if TagString='test' then
begin
CheckEquals(1,TagParams.Count);
CheckEquals('param1',TagParams.Names[0]);
CheckEquals('test ',TagParams.ValueFromIndex[0]);
ReplaceText := 'template'
end
else if TagString='dream' then ReplaceText := 'think';
end;
procedure TTestTemplateParser.TestAllowTagParamsFunctionLike_replacetag(
Sender: TObject; const TagString: String; TagParams: TStringList; out
ReplaceText: String);
begin
if TagString='uppercase' then
begin
CheckEquals(1,TagParams.Count);
ReplaceText:=UpperCase(TagParams[0]);
end;
end;
procedure TTestTemplateParser.TestAllowTagParamsDelphiStyle_replacetag(
Sender: TObject; const TagString: String; TagParams: TStringList; out
ReplaceText: String);
begin
CheckEquals(2,TagParams.Count);
CheckEquals('param1',TagParams.Names[0]);
CheckEquals('first param',TagParams.ValueFromIndex[0]);
CheckEquals('param2',TagParams.Names[1]);
CheckEquals('second param',TagParams.ValueFromIndex[1]);
ReplaceText := 'Delphi parameter'
end;
initialization
RegisterTest(TTestTemplateParser);
end.