MaskEdit: only use the workaround for issue #0038505 (r64617) if compiler version < 3.2.2.

git-svn-id: trunk@64625 -
This commit is contained in:
bart 2021-02-20 08:34:06 +00:00
parent 89deb31d9e
commit b82ead0cfa

View File

@ -1165,10 +1165,13 @@ procedure TCustomMaskEdit.SetEditText(const AValue: string);
//Note: This is not Delphi compatible, but by design //Note: This is not Delphi compatible, but by design
//Delphi lets you just set EditText of any length, which is extremely dangerous! //Delphi lets you just set EditText of any length, which is extremely dangerous!
var var
S, OldS: String; S: String;
i: Integer; i: Integer;
{$if fpc_fullversion < 30202}
OldS: String;
ULen: PtrInt; ULen: PtrInt;
ClearCh: TUTF8Char; ClearCh: TUTF8Char;
{$endif}
begin begin
if (not IsMasked) then if (not IsMasked) then
begin begin
@ -1183,15 +1186,14 @@ begin
for i := 1 to Utf8Length(S) do for i := 1 to Utf8Length(S) do
if IsLiteral(FMask[i]) then SetCodePoint(S,i,ClearChar(i)); if IsLiteral(FMask[i]) then SetCodePoint(S,i,ClearChar(i));
//Pad resulting string with ClearChar if text is too short //Pad resulting string with ClearChar if text is too short
{$if fpc_fullversion >= 30202}
//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? {$else}
//for the time being do it like this: //workaround for fpc issue #0038337
//Utf8Length(S) corrupts S, so concatenation with ClearChar() fails, leading to an endless loop.
//See issue #0038505
while Utf8Length(S) < FMaskLength do while Utf8Length(S) < FMaskLength do
begin 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; OldS := S;
ULen := Utf8Length(S); ULen := Utf8Length(S);
ClearCh := ClearChar(Ulen+1); ClearCh := ClearChar(Ulen+1);
@ -1199,6 +1201,7 @@ begin
S := OldS + ClearCh; S := OldS + ClearCh;
//debugln(' --> S:',S); //debugln(' --> S:',S);
end; end;
{$endif}
RealSetTextWhileMasked(S); RealSetTextWhileMasked(S);
end; end;
end; end;