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

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

Browse Source 
- 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 -
This commit is contained in:
michael 2016-04-22 11:15:11 +00:00
parent 3c2dab9878
commit bae53fda21
4 changed files with 93 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/fcl-pdf/examples/testfppdf.lpr
View File

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

2
packages/fcl-pdf/src/fppdf.pp
View File

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

66
packages/fcl-pdf/tests/fppdf_test.pas
View File

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

54
packages/fcl-pdf/tests/fpttf_test.pas
View File

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