From d13ac6fe8ac8e9d384fb31ac4b835e5027e0fd55 Mon Sep 17 00:00:00 2001
From: mattias <nc-gaertnma@netcologne.de>
Date: Fri, 24 Jun 2011 18:37:23 +0000
Subject: [PATCH] LCL: fixed TUTF8Parser reading at end of buffer

git-svn-id: trunk@31362 -
---
 lcl/languages/lclstrconsts.ca.po    |  2 +-
 lcl/languages/lclstrconsts.cs.po    |  4 +-
 lcl/languages/lclstrconsts.de.po    |  4 +-
 lcl/languages/lclstrconsts.es.po    |  4 +-
 lcl/languages/lclstrconsts.fi.po    |  2 +-
 lcl/languages/lclstrconsts.fr.po    |  2 +-
 lcl/languages/lclstrconsts.he.po    |  2 +-
 lcl/languages/lclstrconsts.id.po    |  2 +-
 lcl/languages/lclstrconsts.it.po    |  4 +-
 lcl/languages/lclstrconsts.lt.po    |  4 +-
 lcl/languages/lclstrconsts.nl.po    |  2 +-
 lcl/languages/lclstrconsts.no.po    |  2 +-
 lcl/languages/lclstrconsts.pl.po    |  2 +-
 lcl/languages/lclstrconsts.po       |  2 +-
 lcl/languages/lclstrconsts.pt.po    |  4 +-
 lcl/languages/lclstrconsts.pt_BR.po |  4 +-
 lcl/languages/lclstrconsts.ru.po    |  4 +-
 lcl/languages/lclstrconsts.sk.po    |  2 +-
 lcl/languages/lclstrconsts.tr.po    |  2 +-
 lcl/languages/lclstrconsts.uk.po    |  4 +-
 lcl/languages/lclstrconsts.zh_CN.po |  4 +-
 lcl/lclstrconsts.pas                |  2 +-
 lcl/lresources.pp                   | 63 ++++++++++++++++++-----------
 23 files changed, 82 insertions(+), 45 deletions(-)

diff --git a/lcl/languages/lclstrconsts.ca.po b/lcl/languages/lclstrconsts.ca.po
index 304a11f760..4c349aeace 100644
--- a/lcl/languages/lclstrconsts.ca.po
+++ b/lcl/languages/lclstrconsts.ca.po
@@ -1431,7 +1431,7 @@ msgid "Invalid integer number: %s"
 msgstr ""
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr ""
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.cs.po b/lcl/languages/lclstrconsts.cs.po
index 30c5305d74..e891dee799 100644
--- a/lcl/languages/lclstrconsts.cs.po
+++ b/lcl/languages/lclstrconsts.cs.po
@@ -1429,7 +1429,9 @@ msgid "Invalid integer number: %s"
 msgstr "Neplatné celé číslo: %s"
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+#, fuzzy
+#| msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr " (u %d,%d, posun proudu %.8x)"
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.de.po b/lcl/languages/lclstrconsts.de.po
index 532c94f191..4000532821 100644
--- a/lcl/languages/lclstrconsts.de.po
+++ b/lcl/languages/lclstrconsts.de.po
@@ -1435,7 +1435,9 @@ msgid "Invalid integer number: %s"
 msgstr "Ungültiger Integerzahl: %s"
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+#, fuzzy
+#| msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr " (bei %d,%d, Stream-Offset %.8x)"
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.es.po b/lcl/languages/lclstrconsts.es.po
index 4d076756ad..5c1e079e45 100644
--- a/lcl/languages/lclstrconsts.es.po
+++ b/lcl/languages/lclstrconsts.es.po
@@ -1429,7 +1429,9 @@ msgid "Invalid integer number: %s"
 msgstr "Número entero no válido: %s"
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+#, fuzzy
+#| msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr " (en %d,%d, flujo de desplazamiento %.8x)"
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.fi.po b/lcl/languages/lclstrconsts.fi.po
index 967b095e37..061e139a80 100644
--- a/lcl/languages/lclstrconsts.fi.po
+++ b/lcl/languages/lclstrconsts.fi.po
@@ -1412,7 +1412,7 @@ msgid "Invalid integer number: %s"
 msgstr ""
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr ""
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.fr.po b/lcl/languages/lclstrconsts.fr.po
index 8bb4635e9d..163c14746b 100644
--- a/lcl/languages/lclstrconsts.fr.po
+++ b/lcl/languages/lclstrconsts.fr.po
@@ -1435,7 +1435,7 @@ msgid "Invalid integer number: %s"
 msgstr "Nombre entier non valide : %s"
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr ""
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.he.po b/lcl/languages/lclstrconsts.he.po
index c73031b6a5..95fa0309e6 100644
--- a/lcl/languages/lclstrconsts.he.po
+++ b/lcl/languages/lclstrconsts.he.po
@@ -1426,7 +1426,7 @@ msgid "Invalid integer number: %s"
 msgstr "מספר שלם לא חוקי %s"
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr ""
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.id.po b/lcl/languages/lclstrconsts.id.po
index edb223e666..c0427e79f8 100644
--- a/lcl/languages/lclstrconsts.id.po
+++ b/lcl/languages/lclstrconsts.id.po
@@ -1432,7 +1432,7 @@ msgid "Invalid integer number: %s"
 msgstr ""
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr ""
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.it.po b/lcl/languages/lclstrconsts.it.po
index ec883e02b4..36798003b2 100644
--- a/lcl/languages/lclstrconsts.it.po
+++ b/lcl/languages/lclstrconsts.it.po
@@ -1434,7 +1434,9 @@ msgid "Invalid integer number: %s"
 msgstr "Numero intero non valido: %s"
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+#, fuzzy
+#| msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr " (a %s %d, offset nello stream %.8x)"
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.lt.po b/lcl/languages/lclstrconsts.lt.po
index fdace9f210..e0436bc8c3 100644
--- a/lcl/languages/lclstrconsts.lt.po
+++ b/lcl/languages/lclstrconsts.lt.po
@@ -1433,7 +1433,9 @@ msgid "Invalid integer number: %s"
 msgstr "Netinkamas sveikasis skaičius: %s"
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+#, fuzzy
+#| msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr " (ties %d,%d, srauto poslinkis %.8x)"
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.nl.po b/lcl/languages/lclstrconsts.nl.po
index 28675c6258..ec96d337c4 100644
--- a/lcl/languages/lclstrconsts.nl.po
+++ b/lcl/languages/lclstrconsts.nl.po
@@ -1431,7 +1431,7 @@ msgid "Invalid integer number: %s"
 msgstr ""
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr ""
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.no.po b/lcl/languages/lclstrconsts.no.po
index 5a35dead8f..e38f07df68 100644
--- a/lcl/languages/lclstrconsts.no.po
+++ b/lcl/languages/lclstrconsts.no.po
@@ -1437,7 +1437,7 @@ msgid "Invalid integer number: %s"
 msgstr ""
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr ""
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.pl.po b/lcl/languages/lclstrconsts.pl.po
index b4d27e59fc..26838ea933 100644
--- a/lcl/languages/lclstrconsts.pl.po
+++ b/lcl/languages/lclstrconsts.pl.po
@@ -1425,7 +1425,7 @@ msgid "Invalid integer number: %s"
 msgstr ""
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr ""
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.po b/lcl/languages/lclstrconsts.po
index 93093b3b4a..74415a8100 100644
--- a/lcl/languages/lclstrconsts.po
+++ b/lcl/languages/lclstrconsts.po
@@ -1410,7 +1410,7 @@ msgid "Invalid integer number: %s"
 msgstr ""
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr ""
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.pt.po b/lcl/languages/lclstrconsts.pt.po
index 1247773e41..ece9c62e56 100644
--- a/lcl/languages/lclstrconsts.pt.po
+++ b/lcl/languages/lclstrconsts.pt.po
@@ -1430,7 +1430,9 @@ msgid "Invalid integer number: %s"
 msgstr "Número inteiro inválido: %s"
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+#, fuzzy
+#| msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr "(em %s,%s, deslocamento fluxo %.8x)"
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.pt_BR.po b/lcl/languages/lclstrconsts.pt_BR.po
index 94ae96b64b..10d705de15 100644
--- a/lcl/languages/lclstrconsts.pt_BR.po
+++ b/lcl/languages/lclstrconsts.pt_BR.po
@@ -1424,7 +1424,9 @@ msgid "Invalid integer number: %s"
 msgstr "Número inteiro inválido: %s"
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+#, fuzzy
+#| msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr "(em %s,%s, deslocamento fluxo %.8x)"
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.ru.po b/lcl/languages/lclstrconsts.ru.po
index 98c7da0891..e6c346b018 100644
--- a/lcl/languages/lclstrconsts.ru.po
+++ b/lcl/languages/lclstrconsts.ru.po
@@ -1433,7 +1433,9 @@ msgid "Invalid integer number: %s"
 msgstr "Неверное целое число: %s"
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+#, fuzzy
+#| msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr " (на %d,%d, смещение потока %.8x)"
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.sk.po b/lcl/languages/lclstrconsts.sk.po
index f63b1c7d81..821398c995 100644
--- a/lcl/languages/lclstrconsts.sk.po
+++ b/lcl/languages/lclstrconsts.sk.po
@@ -1434,7 +1434,7 @@ msgid "Invalid integer number: %s"
 msgstr "Neplatné celé číslo: %s"
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr ""
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.tr.po b/lcl/languages/lclstrconsts.tr.po
index c5a9fd91c3..ea78196593 100644
--- a/lcl/languages/lclstrconsts.tr.po
+++ b/lcl/languages/lclstrconsts.tr.po
@@ -1431,7 +1431,7 @@ msgid "Invalid integer number: %s"
 msgstr ""
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr ""
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.uk.po b/lcl/languages/lclstrconsts.uk.po
index c2a89a3989..0a1ba4c62d 100644
--- a/lcl/languages/lclstrconsts.uk.po
+++ b/lcl/languages/lclstrconsts.uk.po
@@ -1423,7 +1423,9 @@ msgid "Invalid integer number: %s"
 msgstr "Невірне ціле число: %s"
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+#, fuzzy
+#| msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr " (на %d,%d, зміщення потоку %.8x)"
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/languages/lclstrconsts.zh_CN.po b/lcl/languages/lclstrconsts.zh_CN.po
index 4d73696045..c5416a86a1 100644
--- a/lcl/languages/lclstrconsts.zh_CN.po
+++ b/lcl/languages/lclstrconsts.zh_CN.po
@@ -1434,7 +1434,9 @@ msgid "Invalid integer number: %s"
 msgstr "无效的整数：%s"
 
 #: lclstrconsts.sparlocinfo
-msgid " (at %d,%d, stream offset %.8x)"
+#, fuzzy
+#| msgid " (at %d,%d, stream offset %.8x)"
+msgid " (at %d,%d, stream offset %d)"
 msgstr "(在 %d,%d, 流偏移 %.8x)"
 
 #: lclstrconsts.sparunterminatedbinvalue
diff --git a/lcl/lclstrconsts.pas b/lcl/lclstrconsts.pas
index fb6e7feea8..116f92bb71 100644
--- a/lcl/lclstrconsts.pas
+++ b/lcl/lclstrconsts.pas
@@ -429,7 +429,7 @@ resourceString
   SParInvalidFloat              = 'Invalid floating point number: %s';
   SParWrongTokenSymbol          = 'Wrong token symbol: %s expected but %s found';
   SParUnterminatedString        = 'Unterminated string';
-  SParLocInfo                   = ' (at %d,%d, stream offset %.8x)';
+  SParLocInfo                   = ' (at %d,%d, stream offset %d)';
   SParUnterminatedBinValue      = 'Unterminated byte value';
 
   // colorbox
diff --git a/lcl/lresources.pp b/lcl/lresources.pp
index 5cd9952c8b..51f97ef574 100644
--- a/lcl/lresources.pp
+++ b/lcl/lresources.pp
@@ -342,13 +342,15 @@ type
     property Count: integer read FCount write SetCount;
   end;
   
+  { TUTF8Parser }
+
   TUTF8Parser = class(TObject)
   private
     fStream : TStream;
     fBuf : pchar;
-    fBufLen : integer;
+    fBufLen : integer; // read
     fPos : integer;
-    fDeltaPos : integer;
+    fLineStart : integer; // column = fPos - fLineStart + 1
     fFloatType : char;
     fSourceLine : integer;
     fToken : char;
@@ -394,6 +396,7 @@ type
     function TokenSymbolIs(const S: string): Boolean;
     property FloatType: Char read fFloatType;
     property SourceLine: Integer read fSourceLine;
+    function SourceColumn: integer;
     property Token: Char read fToken;
   end;
 
@@ -1397,8 +1400,7 @@ begin
     try
       LRSObjectTextToBinary(LFMStream,BinStream);
       BinStream.Position:=0;
-      BinaryToLazarusResourceCode(BinStream,LRSStream,FormClassName
-        ,'FORMDATA');
+      BinaryToLazarusResourceCode(BinStream,LRSStream,FormClassName,'FORMDATA');
     finally
       BinStream.Free;
     end;
@@ -5322,25 +5324,27 @@ begin
 end;
 
 procedure TUTF8Parser.LoadBuffer;
-var toread : integer;
+var newread : integer;
 begin
-  toread:=fStream.Size-fStream.Position;
-  if toread>ParseBufSize then toread:=ParseBufSize;
-  if toread=0 then
-  begin
-    fEofReached:=true;
-    exit;
-  end;
-  fStream.ReadBuffer(fBuf[0],toread);
-  fBuf[toread]:=#0;
-  inc(fDeltaPos,fPos);
+  newread:=fStream.Read(fBuf[0],ParseBufSize);
+  fBuf[newread]:=#0;
+  fLineStart:=fPos-fLineStart;
   fPos:=0;
-  fBufLen:=toread;
+  fBufLen:=newread;
+  fEofReached:=newread=0;
 end;
 
 procedure TUTF8Parser.CheckLoadBuffer; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
 begin
-  if fBuf[fPos]=#0 then LoadBuffer;
+  if fBuf[fPos]<>#0 then exit;
+  if fPos<fBufLen then begin
+    // skip #0
+    repeat
+      inc(fPos);
+      if fBuf[fPos]<>#0 then exit;
+    until (fPos=fBufLen);
+  end;
+  LoadBuffer;
 end;
 
 procedure TUTF8Parser.ProcessChar; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
@@ -5400,22 +5404,26 @@ begin
     CheckLoadBuffer;
     if fBuf[fPos]=#10 then inc(fPos); //CR LF
   end
-  else inc(fPos); //LF
+  else begin
+    inc(fPos); //LF
+    CheckLoadBuffer;
+  end;
   inc(fSourceLine);
-  fDeltaPos:=-(fPos-1);
+  fLineStart:=fPos;
 end;
 
 procedure TUTF8Parser.SkipSpaces;
 begin
-  while fBuf[fPos] in [' ',#9] do
+  while fBuf[fPos] in [' ',#9] do begin
     inc(fPos);
+    CheckLoadBuffer;
+  end;
 end;
 
 procedure TUTF8Parser.SkipWhitespace;
 begin
   while true do
   begin
-    CheckLoadBuffer;
     case fBuf[fPos] of
       ' ',#9  : SkipSpaces;
       #10,#13 : HandleNewLine
@@ -5472,6 +5480,7 @@ begin
   begin
     fFloatType:=fBuf[fPos];
     inc(fPos);
+    CheckLoadBuffer;
     fToken:=toFloat;
   end
   else fFloatType:=#0;
@@ -5578,6 +5587,7 @@ begin
   fToken:=fBuf[fPos];
   fLastTokenStr:=fToken;
   inc(fPos);
+  CheckLoadBuffer;
 end;
 
 constructor TUTF8Parser.Create(Stream: TStream);
@@ -5586,7 +5596,7 @@ begin
   fBuf:=GetMem(ParseBufSize+1);
   fBufLen:=0;
   fPos:=0;
-  fDeltaPos:=1;
+  fLineStart:=0;
   fSourceLine:=1;
   fEofReached:=false;
   fLastTokenStr:='';
@@ -5627,7 +5637,8 @@ end;
 
 procedure TUTF8Parser.ErrorStr(const Message: string);
 begin
-  raise EParserError.CreateFmt(Message+SParLocInfo,[SourceLine,fPos+fDeltaPos,SourcePos]);
+  debugln(['TUTF8Parser.ErrorStr Message="',Message,'" at y=',SourceLine,',x=',SourceColumn]);
+  raise EParserError.CreateFmt(Message+SParLocInfo,[SourceLine,SourceColumn,SourcePos]);
 end;
 
 procedure TUTF8Parser.HexToBinary(Stream: TStream);
@@ -5646,6 +5657,7 @@ begin
       Error(SParUnterminatedBinValue);
     b:=b or GetHexValue(fBuf[fPos]);
     inc(fPos);
+    CheckLoadBuffer;
     outbuf[i]:=b;
     inc(i);
     if i>=ParseBufSize then
@@ -5729,6 +5741,11 @@ begin
   Result:=(fToken=toSymbol) and (CompareText(fLastTokenStr,S)=0);
 end;
 
+function TUTF8Parser.SourceColumn: integer;
+begin
+  Result:=fPos-fLineStart+1;
+end;
+
 //------------------------------------------------------------------------------
 procedure InternalInit;
 begin