* Some fixes from Graeme Geldenhuys (Bug ID 30038):

  - pdf unittests: Minor improvement to PDFString.TestWrite()
  - pdf: fixes FPC bug ID #30038 and implements TPDFUTF8String unit tests.
  - pdf test: Extended the SimpleText() text output to show more symbols

git-svn-id: trunk@33543 -

packages/fcl-pdf/examples/testfppdf.lpr

@@ -166,7 +166,7 @@ begin
   P.WriteText(15, 200, 'Typography: “What’s wrong?”');
   P.WriteText(40, 210, '£17.99 vs £17·99');
   P.WriteText(40, 220, '€17.99 vs €17·99');
-  P.WriteText(40, 230, 'OK then…    êçèûÎÐð£¢ß');
+  P.WriteText(40, 230, 'OK then…    (êçèûÎÐð£¢ß)  \\//{}()#<>');
 
   P.WriteText(25, 280, 'B субботу двадцать третьего мая приезжает твоя любимая теща.');
 end;

packages/fcl-pdf/src/fppdf.pp

@@ -2408,8 +2408,6 @@ begin
   inherited Create(ADocument);
   FValue := AValue;
   FFontIndex := AFontIndex;
-  if (Pos('(', FValue) > 0) or (Pos(')', FValue) > 0) or (Pos('\', FValue) > 0) then
-    FValue := InsertEscape(FValue);
 end;
 
 { TPDFArray }

packages/fcl-pdf/tests/fppdf_test.pas

@@ -82,6 +82,7 @@ type
     procedure   TestInsertEscape;
   end;
 
+
   TTestPDFString = class(TBasePDFTest)
   published
     procedure   TestWrite;
@@ -90,6 +91,13 @@ type
   end;
 
 
+  TTestPDFUTF8String = class(TBasePDFTest)
+  published
+    procedure   TestWrite;
+    procedure   TestWriteEscaped;
+  end;
+
+
   TTestPDFArray = class(TBasePDFTest)
   published
     procedure   TestWrite;
@@ -242,6 +250,9 @@ implementation
 uses
   FPImage;
 
+const
+  cFont1 = 'fonts' + PathDelim + 'LiberationSans-Regular.ttf';
+
 type
   // so we can access Protected methods in the tests
   TMockPDFObject = class(TPDFObject);
@@ -252,6 +263,7 @@ type
   TMockPDFReference = class(TPDFReference);
   TMockPDFName = class(TPDFName);
   TMockPDFString = class(TPDFString);
+  TMockPDFUTF8String = class(TPDFUTF8String);
   TMockPDFArray = class(TPDFArray);
   TMockPDFStream = class(TPDFStream);
   TMockPDFEmbeddedFont = class(TPDFEmbeddedFont);
@@ -568,11 +580,13 @@ begin
     o.Free;
   end;
 
+  S.Size := 0;  // empty out the Stream data
+
   { Length1 seems to be a special case? }
   o := TPDFString.Create(PDF, #$C2#$A3+#$C2#$BB); //  UTF-8 text of "£»"
   try
     TMockPDFString(o).Write(S);  // write will convert UTF-8 to ANSI
-    AssertEquals('Failed on 3', '(Test)('+#163#187+')', S.DataString);
+    AssertEquals('Failed on 3', '('+#163#187+')', S.DataString);
   finally
     o.Free;
   end;
@@ -607,6 +621,55 @@ begin
   end;
 end;
 
+{ TTestPDFUTF8String }
+
+procedure TTestPDFUTF8String.TestWrite;
+var
+  o: TPDFUTF8String;
+  fnt: integer;
+begin
+  PDF.Options := []; // disable all compression
+  fnt := PDF.AddFont(cFont1, 'Liberation Sans', clBlack);
+  o := TPDFUTF8String.Create(PDF, 'TestT', fnt);
+  try
+    AssertEquals('Failed on 1', '', S.DataString);
+    TMockPDFUTF8String(o).Write(S);
+    //                             T | e | s | t | T |
+    AssertEquals('Failed on 2', '<00370048005600570037>', S.DataString);
+  finally
+    o.Free;
+  end;
+
+  S.Size := 0;  // empty out the Stream data
+
+  { Length1 seems to be a special case? }
+  o := TPDFUTF8String.Create(PDF, #$C2#$A3+#$C2#$BB, fnt); //  UTF-8 text of "£»"
+  try
+    TMockPDFUTF8String(o).Write(S);
+    //                             £ | » |
+    AssertEquals('Failed on 3', '<0065007D>', S.DataString);
+  finally
+    o.Free;
+  end;
+end;
+
+procedure TTestPDFUTF8String.TestWriteEscaped;
+var
+  o: TPDFUTF8String;
+  fnt: integer;
+begin
+  fnt := PDF.AddFont(cFont1, 'Liberation Sans', clBlack);
+  o := TPDFUTF8String.Create(PDF, 'a(b)c\def/g', fnt);
+  try
+    AssertEquals('Failed on 1', '', S.DataString);
+    TMockPDFUTF8String(o).Write(S);
+    //                              a| ( | b | ) | c | \ | d | e | f | / | g |
+    AssertEquals('Failed on 2', '<0044000B0045000C0046003F0047004800490012004A>', S.DataString);
+  finally
+    o.Free;
+  end;
+end;
+
 { TTestPDFArray }
 
 procedure TTestPDFArray.TestWrite;
@@ -1741,6 +1804,7 @@ initialization
   RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFName{$ifdef fptest}.Suite{$endif});
   RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFAbstractString{$ifdef fptest}.Suite{$endif});
   RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFString{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFUTF8String{$ifdef fptest}.Suite{$endif});
   RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFArray{$ifdef fptest}.Suite{$endif});
   RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFStream{$ifdef fptest}.Suite{$endif});
   RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFEmbeddedFont{$ifdef fptest}.Suite{$endif});

packages/fcl-pdf/tests/fpttf_test.pas

@@ -76,35 +76,35 @@ end;
 procedure TFPFontCacheItemTest.TestIsRegular;
 begin
   { regular should be the default flag set }
-  CheckEquals(True, CI.IsRegular, 'Failed on 1');
+  AssertEquals('Failed on 1', True, CI.IsRegular);
 end;
 
 procedure TFPFontCacheItemTest.TestIsBold;
 begin
-  CheckEquals(False, CI.IsBold, 'Failed on 1');
+  AssertEquals('Failed on 1', False, CI.IsBold);
 end;
 
 procedure TFPFontCacheItemTest.TestIsItalic;
 begin
-  CheckEquals(False, CI.IsItalic, 'Failed on 1');
+  AssertEquals('Failed on 1', False, CI.IsItalic);
 end;
 
 procedure TFPFontCacheItemTest.TestIsFixedWidth;
 begin
-  CheckEquals(False, CI.IsFixedWidth, 'Failed on 1');
+  AssertEquals('Failed on 1', False, CI.IsFixedWidth);
 end;
 
 procedure TFPFontCacheItemTest.TestRegularVsFixedWidth;
 begin
-  CheckEquals(True, CI.IsRegular, 'Failed on 1');
-  CheckEquals(False, CI.IsFixedWidth, 'Failed on 2');
+  AssertEquals('Failed on 1', True, CI.IsRegular);
+  AssertEquals('Failed on 2', False, CI.IsFixedWidth);
 end;
 
 procedure TFPFontCacheItemTest.TestFileName;
 begin
-  CheckTrue(CI.FileName <> '', 'Failed on 1');
+  AssertTrue('Failed on 1', CI.FileName <> '');
   { FileName is a non-existing file though, so FontData should be nil }
-  CheckTrue(CI.FontData = nil, 'Failed on 2');
+  AssertTrue('Failed on 2', CI.FontData = nil);
 end;
 
 procedure TFPFontCacheItemTest.TestTextWidth_FontUnits;
@@ -185,40 +185,40 @@ end;
 
 procedure TFPFontCacheListTest.TestCount;
 begin
-  CheckEquals(0, FC.Count, 'Failed on 1');
+  AssertEquals('Failed on 1', 0, FC.Count);
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
-  CheckEquals(0, FC.Count, 'Failed on 2');
+  AssertEquals('Failed on 2', 0, FC.Count);
   FC.BuildFontCache;
-  CheckEquals(4, FC.Count, 'Failed on 3' + cErrFontCountWrong);
+  AssertEquals('Failed on 3' + cErrFontCountWrong, 4, FC.Count);
 end;
 
 procedure TFPFontCacheListTest.TestBuildFontCache;
 begin
-  CheckEquals(0, FC.Count, 'Failed on 1');
+  AssertEquals('Failed on 1', 0, FC.Count);
   try
     FC.BuildFontCache;
     Fail('Failed on 2. We don''t have font paths, so BuildFontCache shouldn''t run.');
   except
     on e: Exception do
       begin
-        CheckEquals(E.ClassName, 'ETTF', 'Failed on 3.');
+        AssertEquals('Failed on 3', E.ClassName, 'ETTF');
       end;
   end;
 
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
-  CheckEquals(0, FC.Count, 'Failed on 4');
+  AssertEquals('Failed on 4', 0, FC.Count);
   FC.BuildFontCache;
-  CheckEquals(4, FC.Count, 'Failed on 5' + cErrFontCountWrong);
+  AssertEquals('Failed on 5' + cErrFontCountWrong, 4, FC.Count);
 end;
 
 procedure TFPFontCacheListTest.TestClear;
 begin
-  CheckEquals(0, FC.Count, 'Failed on 1');
+  AssertEquals('Failed on 1', 0, FC.Count);
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   FC.BuildFontCache;
-  CheckEquals(4, FC.Count, 'Failed on 2');
+  AssertEquals('Failed on 2', 4, FC.Count);
   FC.Clear;
-  CheckEquals(0, FC.Count, 'Failed on 3');
+  AssertEquals('Failed on 3', 0, FC.Count);
 end;
 
 procedure TFPFontCacheListTest.TestFind_FamilyName;
@@ -226,29 +226,29 @@ var
   lCI: TFPFontCacheItem;
 begin
   lCI := nil;
-  CheckEquals(0, FC.Count, 'Failed on 1');
+  AssertEquals('Failed on 1', 0, FC.Count);
   lCI := FC.Find('Ubuntu');
-  CheckTrue(lCI = nil, 'Failed on 2');
+  AssertTrue('Failed on 2', lCI = nil);
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   FC.BuildFontCache;
-  CheckEquals(4, FC.Count, 'Failed on 3' + cErrFontCountWrong);
+  AssertEquals('Failed on 3' + cErrFontCountWrong, 4, FC.Count);
   lCI := FC.Find('Ubuntu');
-  CheckTrue(Assigned(lCI), 'Failed on 4');
+  AssertTrue('Failed on 4', Assigned(lCI));
 
   { TODO: We should try and extend this to make font paths user configure
            thus the tests could be more flexible. }
 
   lCI := FC.Find('Ubuntu', True); // bold font
-  CheckTrue(lCI = nil, 'Failed on 5');
+  AssertTrue('Failed on 5', lCI = nil);
   lCI := FC.Find('Ubuntu', False, True); // italic font
-  CheckTrue(lCI = nil, 'Failed on 6');
+  AssertTrue('Failed on 6', lCI = nil);
   lCI := FC.Find('Ubuntu', True, True); // bold+italic font
-  CheckTrue(lCI = nil, 'Failed on 7');
+  AssertTrue('Failed on 7', lCI = nil);
 
   lCI := FC.Find('DejaVu Sans');
-  CheckTrue(Assigned(lCI), 'Failed on 8');
+  AssertTrue('Failed on 8', Assigned(lCI));
   lCI := FC.Find('DejaVu Sans Bold');
-  CheckTrue(lCI = nil, 'Failed on 9');
+  AssertTrue('Failed on 9', lCI = nil);
 end;