RTL Fehler beheben - System.pas

[arcticwolf]

Es geht um das Verhalten von "Write".

Prinzipiell gilt:

Delphi-Quellcode:

i : Integer = 567;
d : Double  = 567.89;

Write(i:5)     -> 'xx567'
Write(d:10:2)  -> 'xxxx567.89'

Wobei x hier für die führenden Leerstellen steht.

Das funktioniert aber nur solage die AlternateWriteUnicodeStringProc aus der System.pas nicht aktiviert ist.

Wenn AlternateWriteUnicodeStringProc aktiviert ist, dann liefert _WriteUString an die AlternateWriteUnicodeStringProc bei Integer-Werten einen String ohne führende Leerstellen.

Write(i:5) -> '567'

--------------------------------------

Der Fehler liegt in der _WriteUString und/oder in der _WriteLong

Delphi-Quellcode:

function _WriteUString(var t: TTextRec; const s: UnicodeString; width: Integer): Pointer;
var
  i: Integer;
  A: _AnsiStr;
begin
  if s = '' then
    Result := _WriteSpaces(t, width )
  else
  begin
    if t.CodePage = 0 then TryOpenForOutput(t);
    if t.CodePage = CP_UTF16 then // Output is UTF16
    begin
      i := Length(s);
      _WriteSpaces(t, width - i);
      Result := _WriteBytes(t, s[Low(string)], i*sizeof(WideChar));
    end
    else
    begin
      if assigned(AlternateWriteUnicodeStringProc) then
        Result := AlternateWriteUnicodeStringProc(t, s)
      else
      begin
        _LStrFromUStr(A, s, t.CodePage);
        i := Length(A);
        _WriteSpaces(t, width - i);
        Result := _WriteBytes(t, A[Low(string)], i);
      end;
    end;
  end;
end;

Delphi-Quellcode:

function _WriteLong(var t: TTextRec; val, width: Integer): Pointer;
var
{$IFNDEF NEXTGEN}
  S: string[31];
{$ELSE}
  S: _ShortStr;
{$ENDIF}
begin
  Str(val:0, S);
  Result := _WriteString(t, S, width);
end;

Korrekt wäre in _WriteLong

  Str(val:width, S);

Oder aber in _WriteUString könnte der Fehler wie folgt behoben werden.

Delphi-Quellcode:

      if assigned(AlternateWriteUnicodeStringProc) then
        Result := AlternateWriteUnicodeStringProc(t, s.PadLeft(width))
      else

In Abweichung zu _WriteLong liefert zum Beispiel _Write2Ext

function _Write2Ext(var T: TTextRec; Val: Extended; Width, Prec: Integer): Pointer;

den korrekten String mit führenden Leerstellen an _WriteUString, sodass der Fehler dort dann nicht zum tragen kommt.