* 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

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

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)

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.

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.
+