# revisions: 45226,45647,45648,45649,45657

git-svn-id: branches/fixes_3_2@45687 -

packages/fcl-image/src/fpreadpnm.pp

@@ -28,12 +28,24 @@ interface
 
 uses FPImage, classes, sysutils;
 
+Const
+  BufSize = 1024;
+
 type
+
+  { TFPReaderPNM }
+
   TFPReaderPNM=class (TFPCustomImageReader)
     private
       FBitMapType : Integer;
       FWidth      : Integer;
       FHeight     : Integer;
+      FBufPos : Integer;
+      FBufLen : Integer;
+      FBuffer : Array of char;
+      function DropWhiteSpaces(Stream: TStream): Char;
+      function ReadChar(Stream: TStream): Char;
+      function ReadInteger(Stream: TStream): Integer;
     protected
       FMaxVal     : Cardinal;
       FBitPP        : Byte;
@@ -54,11 +66,12 @@ const
 
 { The magic number at the beginning of a pnm file is 'P1', 'P2', ..., 'P7'
   followed by a WhiteSpace character }
+
 function TFPReaderPNM.InternalCheck(Stream:TStream):boolean;
 var
   hdr: array[0..2] of char;
   oldPos: Int64;
-  n: Integer;
+  i,n: Integer;
 begin
   Result:=False;
   if Stream = nil then
@@ -66,32 +79,36 @@ begin
   oldPos := Stream.Position;
   try
     n := SizeOf(hdr);
-    Result:=(Stream.Read(hdr[0], n) = n)
-            and (hdr[0] = 'P') 
+    Result:=(Stream.Size-OldPos>=N);
+    if not Result then exit;
+    For I:=0 to N-1 do
+      hdr[i]:=ReadChar(Stream);
+    Result:=(hdr[0] = 'P')
             and (hdr[1] in ['1'..'7']) 
             and (hdr[2] in WhiteSpaces);
   finally
     Stream.Position := oldPos;
+    FBufLen:=0;
   end;
 end;
 
-function DropWhiteSpaces(Stream : TStream) :Char;
+function TFPReaderPNM.DropWhiteSpaces(Stream : TStream) :Char;
 
 begin
   with Stream do
     begin
     repeat
-      ReadBuffer(DropWhiteSpaces,1);
+      Result:=ReadChar(Stream);
 {If we encounter comment then eate line}
       if DropWhiteSpaces='#' then
       repeat
-        ReadBuffer(DropWhiteSpaces,1);
-      until DropWhiteSpaces=#10;
-    until not(DropWhiteSpaces in WhiteSpaces);
+        Result:=ReadChar(Stream);
+      until Result=#10;
+    until not (Result in WhiteSpaces);
     end;
 end;
 
-function ReadInteger(Stream : TStream) :Integer;
+function TFPReaderPNM.ReadInteger(Stream : TStream) :Integer;
 
 var
   s:String[7];
@@ -99,25 +116,39 @@ var
 begin
   s:='';
   s[1]:=DropWhiteSpaces(Stream);
-  with Stream do
-    repeat
-      Inc(s[0]);
-      ReadBuffer(s[Length(s)+1],1)
-    until (s[0]=#7) or (s[Length(s)+1] in WhiteSpaces);
+  repeat
+    Inc(s[0]);
+    s[Length(s)+1]:=ReadChar(Stream);
+  until (s[0]=#7) or (s[Length(s)+1] in WhiteSpaces);
   Result:=StrToInt(s);
 end;
 
+Function TFPReaderPNM.ReadChar(Stream : TStream) : Char;
+
+begin
+  If (FBufPos>=FBufLen) then
+    begin
+    if Length(FBuffer)=0 then
+      SetLength(FBuffer,BufSize);
+    FBufLen:=Stream.Read(FBuffer[0],Length(FBuffer));
+    if FBuflen=0 then
+      Raise EReadError.Create('Failed to read from stream');
+    FBufPos:=0;
+    end;
+  Result:=FBuffer[FBufPos];
+  Inc(FBufPos);
+end;
+
 procedure TFPReaderPNM.ReadHeader(Stream : TStream);
 
 Var
   C : Char;
 
 begin
-  C:=#0;
-  Stream.ReadBuffer(C,1);
+  C:=ReadChar(Stream);
   If (C<>'P') then
     Raise Exception.Create('Not a valid PNM image.');
-  Stream.ReadBuffer(C,1);
+  C:=ReadChar(Stream);
   FBitmapType:=Ord(C)-Ord('0');
   If Not (FBitmapType in [1..6]) then
     Raise Exception.CreateFmt('Unknown PNM subtype : %s',[C]);

packages/fcl-stl/src/ghashmap.pp

@@ -73,15 +73,15 @@
           Key:TKey;
         end;
       var
-      private 
+      private
       type
         TContainer = specialize TVector<TPair>;
         TTable = specialize TVector<TContainer>;
-      var 
+      var
         FData:TTable;
-        FDataSize:SizeUInt; 
+        FDataSize:SizeUInt;
         procedure EnlargeTable;
-      public 
+      public
       type
         TIterator = specialize THashmapIterator<TKey, TValue, TPair, TTable>;
         constructor Create;
@@ -124,7 +124,7 @@ begin
 end;
 
 procedure THashmap.EnlargeTable;
-var i,j,h,oldDataSize:SizeUInt; 
+var i,j,h,oldDataSize:SizeUInt;
     curbucket:TContainer;
     value:TPair;
 begin
@@ -195,6 +195,7 @@ begin
 {$endif}
     inc(i);
   end;
+  Result:=Default(TValue);
   // exception?
 end;
 

packages/fcl-stl/tests/gdequetest.pp

@@ -14,7 +14,7 @@ type TGDequeTest = class(TTestCase)
     procedure PushTest;
   public
     procedure Setup;override;
-  private 
+  private
     data:dequelli;
   end;
 
@@ -28,7 +28,7 @@ begin
     data.pushback(i);
   for i:=0 to 10 do begin
     AssertEquals('Wrong data', 10-i, data.back);
-    AssertEquals('Wrong size', 11-i, data.size);
+    AssertEquals('Wrong size', 11-i, SizeInt(data.size));
     data.popback;
   end;
   AssertEquals('Not IsEmpty', true, data.IsEmpty);

packages/fcl-stl/tests/gpriorityqueuetest.pp

@@ -14,7 +14,7 @@ type TGPQueueTest = class(TTestCase)
     procedure QueueTest;
   public
     procedure Setup;override;
-  private 
+  private
     data:queuelli;
   end;
 
@@ -30,7 +30,7 @@ begin
   data.pop;
   for i:=0 to 9 do begin
     AssertEquals('Wrong order', true, data.top<last);
-    AssertEquals('Wrong size', 10-i, data.size);
+    AssertEquals('Wrong size', 10-i, SizeInt(data.size));
     last:=data.top;
     data.pop;
   end;

packages/fcl-stl/tests/gqueuetest.pp

@@ -13,7 +13,7 @@ type TGTQueueTest = class(TTestCase)
     procedure TQueueTest;
   public
     procedure Setup;override;
-  private 
+  private
     data:TQueuelli;
   end;
 
@@ -27,7 +27,7 @@ begin
     data.push(i);
   for i:=0 to 10 do begin
     AssertEquals('Wrong data', i, data.front);
-    AssertEquals('Wrong size', 11-i, data.size);
+    AssertEquals('Wrong size', 11-i, SizeInt(data.size));
     data.pop;
   end;
   AssertEquals('Not IsEmpty', true, data.IsEmpty);

packages/mysql/src/mysql.inc

@@ -2099,4 +2099,3 @@ end;
 initialization
   Refcount := 0;
 {$ENDIF}
-end.

rtl/inc/systemh.inc

@@ -1491,7 +1491,7 @@ function InterlockedIncrement64 (var Target: qword) : qword; external name 'FPC_
 function InterlockedDecrement64 (var Target: qword) : qword; external name 'FPC_INTERLOCKEDDECREMENT64';
 function InterlockedExchange64 (var Target: qword;Source : qword) : qword; external name 'FPC_INTERLOCKEDEXCHANGE64';
 function InterlockedExchangeAdd64 (var Target: qword;Source : qword) : qword; external name 'FPC_INTERLOCKEDEXCHANGEADD64';
-function InterlockedCompareExchange64(var Target: qword; NewValue: qword; Comperand: qword): int64; external name 'FPC_INTERLOCKEDCOMPAREEXCHANGE64';
+function InterlockedCompareExchange64(var Target: qword; NewValue: qword; Comperand: qword): qword; external name 'FPC_INTERLOCKEDCOMPAREEXCHANGE64';
 {$endif cpu64}