From 0e0a5dee4f8174b8da8677c165b38285381b9eac Mon Sep 17 00:00:00 2001 From: joost Date: Tue, 20 Mar 2012 16:13:14 +0000 Subject: [PATCH] * TTemplateParser: Do not require a space between the tag name and the ParamStartDelimiter. * Allow parameters without any name, for example: {uppercase[-this-]} * Added simple tests for TTemplateParser git-svn-id: trunk@20543 - --- .gitattributes | 2 + packages/fcl-base/src/fptemplate.pp | 26 ++- packages/fcl-base/tests/fclbase-unittests.pp | 17 ++ packages/fcl-base/tests/tests_fptemplate.pp | 192 +++++++++++++++++++ 4 files changed, 227 insertions(+), 10 deletions(-) create mode 100644 packages/fcl-base/tests/fclbase-unittests.pp create mode 100644 packages/fcl-base/tests/tests_fptemplate.pp diff --git a/.gitattributes b/.gitattributes index 7bd1753816..dc483e617d 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/packages/fcl-base/src/fptemplate.pp b/packages/fcl-base/src/fptemplate.pp index 0c7fb94e2b..46897dd45f 100644 --- a/packages/fcl-base/src/fptemplate.pp +++ b/packages/fcl-base/src/fptemplate.pp @@ -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) diff --git a/packages/fcl-base/tests/fclbase-unittests.pp b/packages/fcl-base/tests/fclbase-unittests.pp new file mode 100644 index 0000000000..08383b1901 --- /dev/null +++ b/packages/fcl-base/tests/fclbase-unittests.pp @@ -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. diff --git a/packages/fcl-base/tests/tests_fptemplate.pp b/packages/fcl-base/tests/tests_fptemplate.pp new file mode 100644 index 0000000000..2e64dacd5b --- /dev/null +++ b/packages/fcl-base/tests/tests_fptemplate.pp @@ -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. +