writeln的明显副作用(":width"说明符导致输出中出现问号)

Question

我有以下代码(RAD Studio XE2,Windows 7 x64):

program letters;

{$APPTYPE CONSOLE}

{$DEFINE BOO}

const
  ENGLISH_ALPHABET = 'abcdefghijklmnopqrstuvwxyz';

begin
{$IFDEF BOO}
  writeln;
{$ENDIF}
  write(ENGLISH_ALPHABET[1]:3);

  readln;
end.

当{$DEFINE BOO}指令关闭时,我有以下(预期)输出(为了便于阅读,空格被替换为点):

..a

当指令打开时,我有以下(意外)输出:

// empty line here
?..a

而不是预期的

// empty line here
..a

当我改为const ENGLISH_ALPHABET时const ENGLISH_ALPHABET: AnsiString,预期的输出打印没有问题字符.当:3格式化被删除或改变:1,没有问号.当输出重定向到文件时(通过AssignFile(Output, 'boo.log')命令行或从命令行),再没有问号.

这种行为的正确解释是什么？

Answer 1

这是RTL中一个相当奇怪的错误.呼叫write解决呼叫_WriteWChar.这个函数实现如下:

function _WriteWChar(var t: TTextRec; c: WideChar; width: Integer): Pointer;
begin
  if width <= 1 then
    result := _Write0WChar(t, c)
  else
  begin
    if t.UTF16Buffer[0] <> #0 then
    begin
      _Write0WChar(t, '?');
      t.UTF16Buffer[0] := #0;
    end;

    _WriteSpaces(t, width - 1);
    Result := _Write0WChar(t, c);
  end;
end;

在?你看到的是由上面的代码发出.

那么,为什么会这样呢？我能构建的最简单的SSCCE是这样的:

{$APPTYPE CONSOLE}
const
  ENGLISH_ALPHABET = 'abcdefghijklmnopqrstuvwxyz';
begin
  writeln;
  write(ENGLISH_ALPHABET[1]:3);
end.

所以,你的第一个电话writeln就解决了这个问题:

function _WriteLn(var t: TTextRec): Pointer;
begin
  if (t.Flags and tfCRLF) <> 0 then
    _Write0Char(t, _AnsiChr(cCR));
  Result := _Write0Char(t, _AnsiChr(cLF));
  _Flush(t);
end;

在这里,您将单个字符,cLFASCII字符10,换行符,推送到输出文本记录中.这导致t.MBCSBuffer被喂食cLF角色.该字符留在缓冲区中,这很好,因为System._Write0Char.WriteUnicodeFromMBCSBuffer这样做:

t.MBCSLength := 0;
t.MBCSBufPos := 0;

但是当_WriteWChar执行时,它会不分青红皂白地查看t.UTF16Buffer.哪个声明TTextRec如下:

type
  TTextRec = packed record 
    ....
    MBCSLength: ShortInt;
    MBCSBufPos: Byte;
    case Integer of
      0: (MBCSBuffer: array[0..5] of _AnsiChr);
      1: (UTF16Buffer: array[0..2] of WideChar);
  end;

所以,MBCSBuffer和UTF16Buffer共享相同的存储.

该错误是_WriteWChar在t.UTF16Buffer不首先检查缓冲区长度的情况下不应该查看内容.没有立即明白如何实现的东西,因为TTextRec没有UTF16Length.相反,如果t.UTF16Buffer包含有意义的内容,那么约定是它的长度由-t.MBCSLength!给出!

所以_WriteWChar也许应该是:

function _WriteWChar(var t: TTextRec; c: WideChar; width: Integer): Pointer;
begin
  if width <= 1 then
    result := _Write0WChar(t, c)
  else
  begin
    if (t.MBCSLength < 0) and (t.UTF16Buffer[0] <> #0) then
    begin
      _Write0WChar(t, '?');
      t.UTF16Buffer[0] := #0;
    end;

    _WriteSpaces(t, width - 1);
    Result := _Write0WChar(t, c);
  end;
end;

这是一个相当卑鄙的黑客修复_WriteWChar.请注意,我无法获得能够System._WriteSpaces调用它的地址.如果你不顾一切地解决这个问题,那就可以做到.

{$APPTYPE CONSOLE}

uses
  Windows;

procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
  OldProtect: DWORD;
begin
  if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    Move(NewCode, Address^, Size);
    FlushInstructionCache(GetCurrentProcess, Address, Size);
    VirtualProtect(Address, Size, OldProtect, @OldProtect);
  end;
end;

type
  PInstruction = ^TInstruction;
  TInstruction = packed record
    Opcode: Byte;
    Offset: Integer;
  end;

procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
  NewCode: TInstruction;
begin
  NewCode.Opcode := $E9;//jump relative
  NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
  PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;

var
  _Write0WChar: function(var t: TTextRec; c: WideChar): Pointer;

function _Write0WCharAddress: Pointer;
asm
  MOV     EAX, offset System.@Write0WChar
end;

function _WriteWCharAddress: Pointer;
asm
  MOV     EAX, offset System.@WriteWChar
end;

function _WriteWChar(var t: TTextRec; c: WideChar; width: Integer): Pointer;
var
  i: Integer;
begin
  if width <= 1 then
    result := _Write0WChar(t, c)
  else
  begin
    if (t.MBCSLength < 0) and (t.UTF16Buffer[0] <> #0) then
    begin
      _Write0WChar(t, '?');
      t.UTF16Buffer[0] := #0;
    end;

    for i := 1 to width - 1 do
      _Write0WChar(t, ' ');
    Result := _Write0WChar(t, c);
  end;
end;

const
  ENGLISH_ALPHABET = 'abcdefghijklmnopqrstuvwxyz';

begin
  @_Write0WChar := _Write0WCharAddress;
  RedirectProcedure(_WriteWCharAddress, @_WriteWChar);

  writeln;
  write(ENGLISH_ALPHABET[1]:3);
end.

我提交了QC#123157.