paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 09:19:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

TMaskEdit: workaround for infinite loop in SetEditText (issue cause by compiler bug). Issue #0038505

Browse Source 
git-svn-id: branches/fixes_2_0@64634 -
This commit is contained in:
mattias 2021-02-20 20:50:36 +00:00
parent 6a91ceb313
commit 0501f61b9b
1 changed files with 19 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
lcl/maskedit.pp
View File

@ -1124,8 +1124,10 @@ procedure TCustomMaskEdit.SetEditText(const AValue: string);
//Note: This is not Delphi compatible, but by design
//Delphi lets you just set EditText of any length, which is extremely dangerous!
var
S: String;
S, OldS: String;
i: Integer;
ULen: PtrInt;
ClearCh: TUTF8Char;
begin
if (not IsMasked) then
begin
@ -1140,7 +1142,22 @@ begin
for i := 1 to Utf8Length(S) do
if IsLiteral(FMask[i]) then SetCodePoint(S,i,ClearChar(i));
//Pad resulting string with ClearChar if text is too short
while Utf8Length(S) < FMaskLength do S := S + ClearChar(Utf8Length(S)+1);
//while Utf8Length(S) < FMaskLength do S := S + ClearChar(Utf8Length(S)+1);
//the above should work again after the release of fpc 3.2.2?
//for the time being do it like this:
while Utf8Length(S) < FMaskLength do
begin
//workaround for fpc issue #0038337
//Utf8Length(S) corrupts S, so concatenation with ClearChar() fails, leading to an endless loop.
//See issue #0038505
OldS := S;
ULen := Utf8Length(S);
ClearCh := ClearChar(Ulen+1);
//DbgOut(['TCustomMaskEdit.SetEditText: S="',S,'", Utf8Length(S)=',ULen,', FMaskLength=',FMaskLength,', ClearChar(',Ulen+1,')=',ClearCh]);
S := OldS + ClearCh;
//debugln(' --> S:',S);
end;
RealSetTextWhileMasked(S);
end;
end;