* Fixes from Graeme Geldenhuys for bug ID #30006 and bug ID #30008:

--------------------------------
  * pdf unittests: fixes failing test after fpPDF changes, plus newtest added.
  * pdf: fixes failing test due to recent changes in fpPDF.
  * pdf tests: new test for new behaviour.
  * pdf: Applies patch from Mantis 30006 - and replaced bitmasks with Sets.
  * pdf tests: Updates the README file with exact font details used by the tests.
  * ttf: fixes debug output directory.
  * pdf: FPC Mantis BugID 30008: fpTTF: wrong Ascender/Descender calculation
  * pdf: fix bug where return value was never set.
  * pdf: fixes compiler hint about uninitialised variables being used.
  * pdf unittests: fixes memory leak in one test.
  * pdf unittests: fixes compiler hint about unused units in uses  clause.

git-svn-id: trunk@33535 -

.gitattributes

@@ -2587,6 +2587,7 @@ packages/fcl-pdf/src/fpparsettf.pp svneol=native#text/plain
 packages/fcl-pdf/src/fppdf.pp svneol=native#text/plain
 packages/fcl-pdf/src/fpttf.pp svneol=native#text/plain
 packages/fcl-pdf/src/fpttfencodings.pp svneol=native#text/plain
+packages/fcl-pdf/tests/fonts/README.txt svneol=native#text/plain
 packages/fcl-pdf/tests/fpparsettf_test.pas svneol=native#text/plain
 packages/fcl-pdf/tests/fppdf_test.pas svneol=native#text/plain
 packages/fcl-pdf/tests/fpttf_test.pas svneol=native#text/plain

packages/fcl-pdf/src/fpparsettf.pp

@@ -864,17 +864,17 @@ end;
 
 function TTFFileInfo.Ascender: SmallInt;
 begin
-  Result:=ToNatural(FOS2Data.sTypoAscender);         // 2 bytes
+  Result:=FOS2Data.sTypoAscender;
 end;
 
 function TTFFileInfo.Descender: SmallInt;
 begin
-  Result := ToNatural(FOS2Data.sTypoDescender);        // 2 bytes
+  Result := FOS2Data.sTypoDescender;
 end;
 
 function TTFFileInfo.Leading: SmallInt;
 begin
-  Result := ToNatural(FOS2Data.sTypoLineGap);
+  Result := FOS2Data.sTypoLineGap;
 end;
 
 function TTFFileInfo.CapHeight: SmallInt;
@@ -882,7 +882,7 @@ begin
   With FOS2Data do
     begin
     if Version>= 2 then
-      Result:=ToNatural(sCapHeight)
+      Result:=sCapHeight
     else
       Result:=Ascender;
     end;

packages/fcl-pdf/src/fppdf.pp

@@ -2025,7 +2025,7 @@ Var
   Str : TStream;
   CWhite : TFPColor; // white color
 begin
-  FillChar(CWhite, SizeOf(CWhite), $FF);
+  FillMem(@CWhite, SizeOf(CWhite), $FF);
   FWidth:=Image.Width;
   FHeight:=Image.Height;
   Str := nil;
@@ -3541,7 +3541,7 @@ end;
 Function TPDFDocument.CreateFontDefs : TPDFFontDefs;
 
 begin
-  TPDFFontDefs.Create(TPDFFont);
+  Result := TPDFFontDefs.Create(TPDFFont);
 end;
 
 Function TPDFDocument.CreatePDFInfos : TPDFInfos;
@@ -3553,7 +3553,7 @@ end;
 Function TPDFDocument.CreatePDFImages : TPDFImages;
 
 begin
-Result:=TPDFImages.Create(Self,TPDFImageItem);
+  Result:=TPDFImages.Create(Self,TPDFImageItem);
 end;
 
 Function TPDFDocument.CreatePDFPages : TPDFPages;

packages/fcl-pdf/src/fpttf.pp

@@ -20,20 +20,12 @@ uses
   contnrs,
   fpparsettf;
 
-const
-  { constants to query FontCacheItem.StyleFlags with. }
-  FP_FONT_STYLE_REGULAR = 1 shl 0;     { Regular, Plain, Book }
-  FP_FONT_STYLE_ITALIC = 1 shl 1;      { Italic }
-  FP_FONT_STYLE_BOLD = 1 shl 2;        { Bold }
-  FP_FONT_STYLE_CONDENSED = 1 shl 3;   { Condensed }
-  FP_FONT_STYLE_EXTRALIGHT = 1 shl 4;  { ExtraLight }
-  FP_FONT_STYLE_LIGHT = 1 shl 5;       { Light }
-  FP_FONT_STYLE_SEMIBOLD = 1 shl 6;    { Semibold }
-  FP_FONT_STYLE_MEDIUM = 1 shl 7;      { Medium }
-  FP_FONT_STYLE_BLACK = 1 shl 8;       { Black }
-  FP_FONT_STYLE_FIXEDWIDTH = 1 shl 9;  { Fixedwidth }
-
 type
+
+  TTrueTypeFontStyle = (fsRegular, fsItalic, fsBold, fsCondensed, fsExtraLight, fsLight, fsSemibold, fsMedium, fsBlack, fsFixedWidth);
+  TTrueTypeFontStyles = set of TTrueTypeFontStyle;
+
+
   { Forward declaration }
   TFPFontCacheList = class;
 
@@ -42,34 +34,30 @@ type
   private
     FFamilyName: String;
     FFileName: String;
-    FStyleFlags: LongWord;
+    FStyleFlags: TTrueTypeFontStyles;
     FFileInfo: TTFFileInfo;
     FOwner: TFPFontCacheList; // reference to FontCacheList that owns this instance
+    procedure   BuildFontCacheItem;
+    procedure   SetStyleIfExists(var AText: string; var AStyleFlags: TTrueTypeFontStyles; const AStyleName: String; const AStyle: TTrueTypeFontStyle);
     function    GetIsBold: boolean;
     function    GetIsFixedWidth: boolean;
     function    GetIsItalic: boolean;
     function    GetIsRegular: boolean;
-    procedure   SetFileName(const AFileName: String);
-    procedure   SetIsBold(AValue: boolean);
-    procedure   SetIsFixedWidth(AValue: boolean);
-    procedure   SetIsItalic(AValue: boolean);
-    procedure   SetIsRegular(AValue: boolean);
   public
     constructor Create(const AFilename: String);
     destructor  Destroy; override;
-    { Returns the actual TTF font file information. }
-    function    GetFontData: TTFFileInfo;
     { Result is in pixels }
     function    TextWidth(AStr: utf8string; APointSize: single): single;
-    property    FileName: String read FFileName write SetFileName;
-    property    FamilyName: String read FFamilyName write FFamilyName;
+    property    FileName: String read FFileName;
+    property    FamilyName: String read FFamilyName;
+    property    FontData: TTFFileInfo read FFileInfo;
     { A bitmasked value describing the full font style }
-    property    StyleFlags: LongWord read FStyleFlags write FStyleFlags;
+    property    StyleFlags: TTrueTypeFontStyles read FStyleFlags;
     { IsXXX properties are convenience properties, internally querying StyleFlags. }
-    property    IsFixedWidth: boolean read GetIsFixedWidth write SetIsFixedWidth;
-    property    IsRegular: boolean read GetIsRegular write SetIsRegular;
-    property    IsItalic: boolean read GetIsItalic write SetIsItalic;
-    property    IsBold: boolean read GetIsBold write SetIsBold;
+    property    IsFixedWidth: boolean read GetIsFixedWidth;
+    property    IsRegular: boolean read GetIsRegular;
+    property    IsItalic: boolean read GetIsItalic;
+    property    IsBold: boolean read GetIsBold;
   end;
 
 
@@ -79,8 +67,6 @@ type
     FSearchPath: TStringList;
     FDPI: integer;
     procedure   SearchForFont(const AFontPath: String);
-    function    BuildFontCacheItem(const AFontFile: String): TFPFontCacheItem;
-    procedure   SetStyleIfExists(var AText: string; var AStyleFlags: integer; const AStyleName: String; const AStyleBit: integer);
     procedure   SetDPI(AValue: integer);
   protected
     function    GetCount: integer; virtual;
@@ -129,101 +115,89 @@ end;
 
 function TFPFontCacheItem.GetIsBold: boolean;
 begin
-  Result := (FStyleFlags and FP_FONT_STYLE_BOLD) <> 0;
+  Result := fsBold in FStyleFlags;
 end;
 
 function TFPFontCacheItem.GetIsFixedWidth: boolean;
 begin
-  Result := (FStyleFlags and FP_FONT_STYLE_FIXEDWIDTH) <> 0;
+  Result := fsFixedWidth in FStyleFlags;
 end;
 
 function TFPFontCacheItem.GetIsItalic: boolean;
 begin
-  Result := (FStyleFlags and FP_FONT_STYLE_ITALIC) <> 0;
+  Result := fsItalic in FStyleFlags;
 end;
 
 function TFPFontCacheItem.GetIsRegular: boolean;
 begin
-  Result := (FStyleFlags and FP_FONT_STYLE_REGULAR) <> 0;
-end;
-
-procedure TFPFontCacheItem.SetFileName(const AFileName: String);
-begin
-  if FFileName = AFileName then Exit;
-  FFileName := AFileName;
-  if FFileInfo<>nil then
-    FreeAndNil(FFileInfo);
-end;
-
-procedure TFPFontCacheItem.SetIsBold(AValue: boolean);
-begin
-  if AValue then
-    FStyleFlags := FStyleFlags or FP_FONT_STYLE_BOLD
-  else
-    FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_BOLD);
-end;
-
-procedure TFPFontCacheItem.SetIsFixedWidth(AValue: boolean);
-begin
-  if AValue then
-    FStyleFlags := FStyleFlags or FP_FONT_STYLE_FIXEDWIDTH
-  else
-    FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_FIXEDWIDTH);
-
-  // if we are FixedWidth, then Regular can't apply
-  FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_REGULAR);
+  Result := fsRegular in FStyleFlags;
 end;
 
-procedure TFPFontCacheItem.SetIsItalic(AValue: boolean);
+procedure TFPFontCacheItem.BuildFontCacheItem;
+var
+  s: string;
 begin
-  if AValue then
-    FStyleFlags := FStyleFlags or FP_FONT_STYLE_ITALIC
-  else
-    FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_ITALIC);
+  s := FFileInfo.PostScriptName;
+  FFamilyName := FFileInfo.FamilyName;
+  if Pos(s, FFamilyName) = 1 then
+    Delete(s, 1, Length(FFamilyName));
+
+  FStyleFlags := [fsRegular];
+
+  // extract simple styles first
+  if FFileInfo.PostScript.isFixedPitch > 0 then
+    FStyleFlags := [fsFixedWidth]; // this should overwrite Regular style
+
+  if FFileInfo.PostScript.ItalicAngle <> 0 then
+    FStyleFlags := FStyleFlags + [fsItalic];
+
+  // Now to more complex styles stored in StyleName field. eg: 'Condensed Medium'
+  SetStyleIfExists(s, FStyleFlags, 'Bold', fsBold);
+  SetStyleIfExists(s, FStyleFlags, 'Condensed', fsCondensed);
+  SetStyleIfExists(s, FStyleFlags, 'ExtraLight', fsExtraLight);
+  SetStyleIfExists(s, FStyleFlags, 'Light', fsLight);
+  SetStyleIfExists(s, FStyleFlags, 'Semibold', fsSemibold);
+  SetStyleIfExists(s, FStyleFlags, 'Medium', fsMedium);
+  SetStyleIfExists(s, FStyleFlags, 'Black', fsBlack);
+  SetStyleIfExists(s, FStyleFlags, 'Oblique', fsItalic);
 end;
 
-procedure TFPFontCacheItem.SetIsRegular(AValue: boolean);
+procedure TFPFontCacheItem.SetStyleIfExists(var AText: string; var AStyleFlags: TTrueTypeFontStyles;
+  const AStyleName: String; const AStyle: TTrueTypeFontStyle);
+var
+  i: integer;
 begin
-  if AValue then
-    FStyleFlags := FStyleFlags or FP_FONT_STYLE_REGULAR
-  else
-    FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_REGULAR);
-
-  // if we are Regular, then FixedWidth can't apply
-  FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_FIXEDWIDTH);
+  i := Pos(AStyleName, AText);
+  if i > 0 then
+  begin
+    AStyleFlags := AStyleFlags + [AStyle];
+    Delete(AText, i, Length(AStyleName));
+  end;
 end;
 
 constructor TFPFontCacheItem.Create(const AFilename: String);
 begin
   inherited Create;
   FFileName := AFilename;
-  FStyleFlags := FP_FONT_STYLE_REGULAR;
+  FStyleFlags := [fsRegular];
+
+  if AFileName = '' then
+    raise ETTF.Create(rsNoFontFileName);
+
+  if FileExists(AFilename) then
+  begin
+    FFileInfo := TTFFileInfo.Create;
+    FFileInfo.LoadFromFile(AFilename);
+    BuildFontCacheItem;
+  end;
 end;
 
 destructor TFPFontCacheItem.Destroy;
 begin
   FFileInfo.Free;
-
   inherited Destroy;
 end;
 
-function TFPFontCacheItem.GetFontData: TTFFileInfo;
-begin
-  if FFileInfo <> nil then
-    Exit(FFileInfo);
-
-  if FileName = '' then
-    raise ETTF.Create(rsNoFontFileName);
-  if FileExists(FileName) then
-  begin
-    FFileInfo := TTFFileInfo.Create;
-    FFileInfo.LoadFromFile(FileName);
-    Result := FFileInfo;
-  end
-  else
-    Result := nil;
-end;
-
 { TextWidth returns with width of the text. If APointSize = 0.0, then it returns
   the text width in Font Units. If APointSize > 0 then it returns the text width
   in Pixels. }
@@ -248,7 +222,6 @@ function TFPFontCacheItem.TextWidth(AStr: utf8string; APointSize: single): singl
     550 * 18 * 72 / ( 72 * 2048 ) = 4.83
 }
 var
-  lFntInfo: TTFFileInfo;
   i: integer;
   lWidth: integer;
   lGIndex: integer;
@@ -262,8 +235,7 @@ begin
   if Length(AStr) = 0 then
     Exit;
 
-  lFntInfo := GetFontData;
-  if not Assigned(lFntInfo) then
+  if not Assigned(FFileInfo) then
     Exit;
 
   {$IFDEF ttfdebug}
@@ -271,13 +243,13 @@ begin
     s := '';
     for i := 0 to 255 do
     begin
-      lGIndex := lFntInfo.GetGlyphIndex(i);
-      lWidth := lFntInfo.GetAdvanceWidth(lGIndex);
+      lGIndex := FFileInfo.GetGlyphIndex(i);
+      lWidth := FFileInfo.GetAdvanceWidth(lGIndex);
       s := s + ',' + IntToStr(lWidth);
     end;
     sl.Add(s);
-    sl.Add('UnitsPerEm = ' + IntToStr(lFntInfo.Head.UnitsPerEm));
-    sl.SaveToFile('/tmp/' + lFntInfo.PostScriptName + '.txt');
+    sl.Add('UnitsPerEm = ' + IntToStr(FFileInfo.Head.UnitsPerEm));
+    sl.SaveToFile(GetTempDir(True) + FFileInfo.PostScriptName + '.txt');
     sl.Free;
   {$ENDIF}
 
@@ -285,8 +257,8 @@ begin
   us := UTF8Decode(AStr);
   for i := 1 to Length(us) do
   begin
-    lGIndex := lFntInfo.GetGlyphIndex(Word(us[i]));
-    lWidth := lWidth + lFntInfo.GetAdvanceWidth(lGIndex);
+    lGIndex := FFileInfo.GetGlyphIndex(Word(us[i]));
+    lWidth := lWidth + FFileInfo.GetAdvanceWidth(lGIndex);
   end;
   if APointSize = 0.0 then
     Result := lWidth
@@ -294,7 +266,7 @@ begin
   begin
     { Converting Font Units to Pixels. The formula is:
       pixels = glyph_units * pointSize * resolution / ( 72 points per inch * THead.UnitsPerEm )  }
-    Result := lWidth * APointSize * FOwner.DPI / (72 * lFntInfo.Head.UnitsPerEm);
+    Result := lWidth * APointSize * FOwner.DPI / (72 * FFileInfo.Head.UnitsPerEm);
   end;
 end;
 
@@ -321,7 +293,7 @@ begin
         if (lowercase(ExtractFileExt(s)) = '.ttf') or
            (lowercase(ExtractFileExt(s)) = '.otf') then
         begin
-          lFont := BuildFontCacheItem(AFontPath + s);
+          lFont := TFPFontCacheItem.Create(AFontPath + s);
           Add(lFont);
         end;
       end;
@@ -330,55 +302,6 @@ begin
   FindClose(sr);
 end;
 
-function TFPFontCacheList.BuildFontCacheItem(const AFontFile: String): TFPFontCacheItem;
-var
-  lFontInfo: TTFFileInfo;
-  s: string;
-  flags: integer;
-begin
-  lFontInfo := TTFFileInfo.Create;
-  try
-    lFontInfo.LoadFromFile(AFontFile);
-
-    Result := TFPFontCacheItem.Create(AFontFile);
-    s := lFontInfo.PostScriptName;
-    Result.FamilyName := lFontInfo.FamilyName;
-
-    // extract simple styles first
-    if lFontInfo.PostScript.isFixedPitch > 0 then
-      Result.StyleFlags := FP_FONT_STYLE_FIXEDWIDTH; // this should overwrite Regular style
-
-    if lFontInfo.PostScript.ItalicAngle <> 0 then
-      Result.StyleFlags := Result.StyleFlags or FP_FONT_STYLE_ITALIC;
-
-    // Now to more complex styles stored in StyleName field. eg: 'Condensed Medium'
-    flags := Result.StyleFlags;
-    SetStyleIfExists(s, flags, 'Bold', FP_FONT_STYLE_BOLD);
-    SetStyleIfExists(s, flags, 'Condensed', FP_FONT_STYLE_CONDENSED);
-    SetStyleIfExists(s, flags, 'ExtraLight', FP_FONT_STYLE_EXTRALIGHT);
-    SetStyleIfExists(s, flags, 'Light', FP_FONT_STYLE_LIGHT);
-    SetStyleIfExists(s, flags, 'Semibold', FP_FONT_STYLE_SEMIBOLD);
-    SetStyleIfExists(s, flags, 'Medium', FP_FONT_STYLE_MEDIUM);
-    SetStyleIfExists(s, flags, 'Black', FP_FONT_STYLE_BLACK);
-    Result.StyleFlags := flags;
-  finally
-    lFontInfo.Free;
-  end;
-end;
-
-procedure TFPFontCacheList.SetStyleIfExists(var AText: string; var AStyleFlags: integer; const AStyleName: String;
-  const AStyleBit: integer);
-var
-  i: integer;
-begin
-  i := Pos(AStyleName, AText);
-  if i > 0 then
-  begin
-    AStyleFlags := AStyleFlags or AStyleBit;
-    Delete(AText, Length(AStyleName), i);
-  end;
-end;
-
 procedure TFPFontCacheList.SetDPI(AValue: integer);
 begin
   if FDPI = AValue then Exit;
@@ -466,16 +389,15 @@ function TFPFontCacheList.Find(const AFamilyName: string; ABold: boolean; AItali
 var
   i: integer;
 begin
-  Result := nil;
   for i := 0 to Count-1 do
   begin
-    if (Items[i].FamilyName = AFamilyName) and (items[i].IsItalic = AItalic)
-        and (items[i].IsBold = ABold) then
-    begin
-      Result := Items[i];
+    Result := Items[i];
+    if (Result.FamilyName = AFamilyName) and (Result.IsItalic = AItalic)
+        and (Result.IsBold = ABold)
+    then
       exit;
-    end;
   end;
+  Result := nil;
 end;
 
 function TFPFontCacheList.PointSizeInPixels(const APointSize: single): single;

packages/fcl-pdf/tests/fonts/README.txt

@@ -0,0 +1,95 @@
+These sets of unit tests requires four font files of specific versions
+each. Here is what the tests were designed against.
+
+ Font File                  |  Size (bytes)   |  Version
+----------------------------+-----------------+-----------------
+DejaVuSans.ttf              |    622,280      |    2.30
+FreeSans.ttf                |  1,563,256      |  412.2268
+LiberationSans-Regular.ttf  |    350,200      |    2.00.1
+Ubuntu-R.ttf                |    353,824      |    0.80
+
+
+Details of the above font files and download locations are as follows.
+
+
+DejaVu Sans
+===========
+Official website:
+    http://dejavu-fonts.org/wiki/Main_Page
+
+Download URL:
+    http://sourceforge.net/projects/dejavu/files/dejavu/2.30/dejavu-fonts-ttf-2.30.tar.bz2
+
+Description:
+    The DejaVu fonts are a font family based on the Vera Fonts. Its purpose is
+    to provide a wider range of characters while maintaining the original look
+    and feel through the process of collaborative development (see authors),
+    under a Free license.
+
+
+FreeSans
+========
+Official website:
+    http://savannah.gnu.org/projects/freefont/
+
+Download URL:
+    http://ftp.gnu.org/gnu/freefont/freefont-ttf-20120503.zip
+
+Description:
+    We aim to provide a useful set of free outline (i.e. OpenType) fonts
+    covering as much as possible of the Unicode character set. The set consists
+    of three typefaces: one monospaced and two proportional (one with uniform
+    and one with modulated stroke).
+
+License:
+    GNU General Public License v3 or later
+
+
+Liberation
+==========
+Official website: 
+    https://fedorahosted.org/liberation-fonts/
+
+Download URL:
+    https://fedorahosted.org/releases/l/i/liberation-fonts/liberation-fonts-ttf-2.00.1.tar.gz
+
+Description:
+    The Liberation(tm) Fonts is a font family which aims at metric compatibility
+    with Arial, Times New Roman, and Courier New. It is sponsored by Red Hat.
+
+License:
+    * The Liberation(tm) version 2.00.0 onward are Licensed under the SIL Open 
+      Font License, Version 1.1.
+    * Older versions of the Liberation(tm) Fonts is released as open source under
+      the GNU General Public License version 2 with exceptions. ​
+      https://fedoraproject.org/wiki/Licensing/LiberationFontLicense 
+
+
+Ubuntu
+======
+Official website:
+    http://font.ubuntu.com/
+
+Download URL:
+    http://font.ubuntu.com/download/ubuntu-font-family-0.80.zip
+
+Description:
+    The Ubuntu typeface has been specially created to complement the Ubuntu
+    tone of voice. It has a contemporary style and contains characteristics
+    unique to the Ubuntu brand that convey a precise, reliable and free
+    attitude.
+
+License:
+    Ubuntu Font Licence. This licence allows the licensed fonts to be used,
+    studied, modified and redistributed freely.
+
+
+TTF Dump output
+===============
+I used the Microsoft "ttfdump.exe" tool to generate the
+file dump output for the Liberation Sans Regular font. I then used that to verify
+the results of the TTF unit tests.
+
+  http://www.microsoft.com/typography/tools/tools.aspx
+
+

packages/fcl-pdf/tests/fpparsettf_test.pas

@@ -9,7 +9,7 @@ uses
   {$ifdef fptest}
   ,TestFramework
   {$else}
-  ,fpcunit, testutils, testregistry
+  ,fpcunit, testregistry
   {$endif}
   ,fpparsettf
   ;
@@ -356,7 +356,6 @@ implementation
 uses
   dateutils
   ,strutils
-  ,IniFiles
   ;
 
 const

packages/fcl-pdf/tests/fppdf_test.pas

@@ -9,7 +9,7 @@ uses
   {$ifdef fptest}
   ,TestFramework
   {$else}
-  ,fpcunit, testutils, testregistry
+  ,fpcunit, testregistry
   {$endif}
   ,fppdf
   ;
@@ -73,6 +73,7 @@ type
     procedure   TestWrite;
     procedure   TestValidNames1;
     procedure   TestValidNames2;
+    procedure   TestValidNames3;
   end;
 
 
@@ -232,7 +233,8 @@ type
 
   TTestTPDFImageItem = class(TTestCase)
   published
-    procedure TestCreateStreamedData;
+    procedure TestCreateStreamedData_Compressed;
+    procedure TestCreateStreamedData_Uncompressed;
   end;
 
 implementation
@@ -509,6 +511,20 @@ var
   o: TPDFName;
 begin
   o := TPDFName.Create(PDF, 'Adobe Green');
+  try
+    AssertEquals('Failed on 1', '', S.DataString);
+    TMockPDFName(o).Write(S);
+    AssertEquals('Failed on 2', '/Adobe#20Green', S.DataString);
+  finally
+    o.Free;
+  end;
+end;
+
+procedure TTestPDFName.TestValidNames3;
+var
+  o: TPDFName;
+begin
+  o := TPDFName.Create(PDF, 'Adobe Green', False);
   try
     AssertEquals('Failed on 1', '', S.DataString);
     TMockPDFName(o).Write(S);
@@ -1630,37 +1646,87 @@ end;
 
 { TTestTPDFImageItem }
 
-procedure TTestTPDFImageItem.TestCreateStreamedData;
+procedure TTestTPDFImageItem.TestCreateStreamedData_Compressed;
 var
+  list: TPDFImages;
   itm: TPDFImageItem;
   img: TFPMemoryImage;
   b: TBytes;
 begin
-  itm := TPDFImageItem.Create(nil);
+  list := TPDFImages.Create(nil, TPDFImageItem);
   try
-    itm.OwnsImage := True;
-    img := TFPMemoryImage.Create(5, 5);
-    itm.Image := img;
-    b := itm.StreamedData;
-    AssertEquals('Failed on 1', 75 {5*5*3}, Length(b));
+    itm := list.AddImageItem;
+    try
+      itm.OwnsImage := True;
+      img := TFPMemoryImage.Create(5, 5);
+      itm.Image := img;
+      b := itm.StreamedData;
+      AssertEquals('Failed on 1', 12, Length(b));
+    finally
+      itm.Free;
+    end;
+
+    itm := list.AddImageItem;
+    try
+      itm.OwnsImage := True;
+      img := TFPMemoryImage.Create(10, 20);
+      itm.Image := img;
+      { this try..except is to prove that we had a bug before, but fixed it. }
+      try
+        b := itm.StreamedData;
+      except
+        Fail('Failed on 2 - itm.StreamedData raised an exception');
+      end;
+      AssertEquals('Failed on 3', 15, Length(b));
+    finally
+      itm.Free;
+    end;
   finally
-    itm.Free;
+    list.Free;
   end;
+end;
 
-  itm := TPDFImageItem.Create(nil);
+procedure TTestTPDFImageItem.TestCreateStreamedData_Uncompressed;
+var
+  pdf: TPDFDocument;
+  list: TPDFImages;
+  itm: TPDFImageItem;
+  img: TFPMemoryImage;
+  b: TBytes;
+begin
+  pdf := TPDFDocument.Create(nil);
+  pdf.Options := [];  // disables the default image compression
+  list := TPDFImages.Create(pdf, TPDFImageItem);
   try
-    itm.OwnsImage := True;
-    img := TFPMemoryImage.Create(10, 20);
-    itm.Image := img;
-    { this try..except as to prove that we had a bug before we fixed it. }
+    itm := list.AddImageItem;
     try
+      itm.OwnsImage := True;
+      img := TFPMemoryImage.Create(5, 5);
+      itm.Image := img;
       b := itm.StreamedData;
-    except
-      Fail('Failed on 2 - itm.StreamedData raised an exception');
+      AssertEquals('Failed on 1', 75 {5*5*3}, Length(b));
+    finally
+      itm.Free;
+    end;
+
+    itm := list.AddImageItem;
+    try
+      itm.OwnsImage := True;
+      img := TFPMemoryImage.Create(10, 20);
+      itm.Image := img;
+      { this try..except is to prove that we had a bug before, but fixed it. }
+      try
+        b := itm.StreamedData;
+      except
+        Fail('Failed on 2 - itm.StreamedData raised an exception');
+      end;
+      AssertEquals('Failed on 3', 600 {10*20*3}, Length(b));
+    finally
+      itm.Free;
     end;
-    AssertEquals('Failed on 3', 600 {10*20*3}, Length(b));
   finally
-    itm.Free;
+    pdf.Free;
+    list.Free;
   end;
 end;
 

packages/fcl-pdf/tests/fpttf_test.pas

@@ -9,7 +9,7 @@ uses
   {$ifdef fptest}
   ,TestFramework
   {$else}
-  ,fpcunit, testutils, testregistry
+  ,fpcunit, testregistry
   {$endif}
   ,fpttf
   ;
@@ -56,6 +56,9 @@ implementation
 uses
   fpparsettf;
 
+resourcestring
+  cErrFontCountWrong =   ' - make sure you only have the 4 test fonts in the "fonts" directory.';
+
 { TFPFontCacheItemTest }
 
 procedure TFPFontCacheItemTest.SetUp;
@@ -72,87 +75,36 @@ end;
 
 procedure TFPFontCacheItemTest.TestIsRegular;
 begin
+  { regular should be the default flag set }
   CheckEquals(True, CI.IsRegular, 'Failed on 1');
-  CI.IsRegular := True;
-  CI.IsRegular := True;  // to make sure bitwise masks work correctly
-  CheckEquals(True, CI.IsRegular, 'Failed on 2');
-  CI.IsItalic := True;
-  CheckEquals(True, CI.IsRegular, 'Failed on 3');
-  CI.IsRegular := False;
-  CheckEquals(False, CI.IsRegular, 'Failed on 4');
-  CI.IsRegular := False;  // to make sure bitwise masks work correctly. eg: xor usage
-  CheckEquals(False, CI.IsRegular, 'Failed on 5');
 end;
 
 procedure TFPFontCacheItemTest.TestIsBold;
 begin
   CheckEquals(False, CI.IsBold, 'Failed on 1');
-  CI.IsBold := True;
-  CI.IsBold := True;  // to make sure bitwise masks work correctly
-  CheckEquals(True, CI.IsBold, 'Failed on 2');
-  CI.IsBold := True;
-  CI.IsItalic := True;
-  CheckEquals(True, CI.IsBold, 'Failed on 3');
-  CI.IsBold := False;
-  CheckEquals(False, CI.IsBold, 'Failed on 4');
-  CI.IsBold := False;  // to make sure bitwise masks work correctly. eg: xor usage
-  CheckEquals(False, CI.IsBold, 'Failed on 5');
 end;
 
 procedure TFPFontCacheItemTest.TestIsItalic;
 begin
   CheckEquals(False, CI.IsItalic, 'Failed on 1');
-  CI.IsItalic := True;
-  CI.IsItalic := True;  // to make sure bitwise masks work correctly
-  CheckEquals(True, CI.IsItalic, 'Failed on 2');
-  CI.IsBold := True;
-  CI.IsItalic := True;
-  CheckEquals(True, CI.IsItalic, 'Failed on 3');
-  CI.IsItalic := False;
-  CheckEquals(False, CI.IsItalic, 'Failed on 4');
-  CI.IsItalic := False;  // to make sure bitwise masks work correctly. eg: xor usage
-  CheckEquals(False, CI.IsItalic, 'Failed on 5');
 end;
 
 procedure TFPFontCacheItemTest.TestIsFixedWidth;
 begin
   CheckEquals(False, CI.IsFixedWidth, 'Failed on 1');
-  CI.IsFixedWidth := True;
-  CheckEquals(True, CI.IsFixedWidth, 'Failed on 2');
-  CI.IsFixedWidth := True;  // to make sure bitwise masks work correctly
-  CheckEquals(True, CI.IsFixedWidth, 'Failed on 3');
-  CI.IsItalic := True;  // changing another bitmask doesn't affect IsFixedWidth
-  CheckEquals(True, CI.IsFixedWidth, 'Failed on 4');
-  CI.IsFixedWidth := False;
-  CheckEquals(False, CI.IsFixedWidth, 'Failed on 5');
-  CI.IsFixedWidth := False;  // to make sure bitwise masks work correctly. eg: xor usage
-  CheckEquals(False, CI.IsFixedWidth, 'Failed on 6');
 end;
 
 procedure TFPFontCacheItemTest.TestRegularVsFixedWidth;
 begin
   CheckEquals(True, CI.IsRegular, 'Failed on 1');
   CheckEquals(False, CI.IsFixedWidth, 'Failed on 2');
-  CI.IsFixedWidth := True;  // this should toggle IsRegular's value
-  CheckEquals(False, CI.IsRegular, 'Failed on 3');
-  CheckEquals(True, CI.IsFixedWidth, 'Failed on 4');
-  CI.IsRegular := True;  // this should toggle IsFixedWidth's value
-  CheckEquals(True, CI.IsRegular, 'Failed on 5');
-  CheckEquals(False, CI.IsFixedWidth, 'Failed on 6');
 end;
 
 procedure TFPFontCacheItemTest.TestFileName;
 begin
-  CI.FileName := '';
-  try
-    CI.GetFontData;
-    Fail('Failed on 1. GetFontData should work if FileName is empty.');
-  except
-    on e: Exception do
-      begin
-        CheckEquals(E.ClassName, 'ETTF', 'Failed on 2.');
-      end;
-  end;
+  CheckTrue(CI.FileName <> '', 'Failed on 1');
+  { FileName is a non-existing file though, so FontData should be nil }
+  CheckTrue(CI.FontData = nil, 'Failed on 2');
 end;
 
 procedure TFPFontCacheItemTest.TestTextWidth_FontUnits;
@@ -237,7 +189,7 @@ begin
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   CheckEquals(0, FC.Count, 'Failed on 2');
   FC.BuildFontCache;
-  CheckEquals(4, FC.Count, 'Failed on 3');
+  CheckEquals(4, FC.Count, 'Failed on 3' + cErrFontCountWrong);
 end;
 
 procedure TFPFontCacheListTest.TestBuildFontCache;
@@ -256,7 +208,7 @@ begin
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   CheckEquals(0, FC.Count, 'Failed on 4');
   FC.BuildFontCache;
-  CheckEquals(4, FC.Count, 'Failed on 5');
+  CheckEquals(4, FC.Count, 'Failed on 5' + cErrFontCountWrong);
 end;
 
 procedure TFPFontCacheListTest.TestClear;
@@ -279,7 +231,7 @@ begin
   CheckTrue(lCI = nil, 'Failed on 2');
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   FC.BuildFontCache;
-  CheckEquals(4, FC.Count, 'Failed on 3');
+  CheckEquals(4, FC.Count, 'Failed on 3' + cErrFontCountWrong);
   lCI := FC.Find('Ubuntu');
   CheckTrue(Assigned(lCI), 'Failed on 4');