Access Violation inesperado aquando do uso de Interfaces

[thoga31]

Caríssimos, decidi desenferrujar algumas linguagens nas quais não tive a chance de pegar há muito. Chegou a hora do Delphi / Object Pascal.

Ora bem, estou a fazer uma pequena biblioteca que me permite aplicar ANSI escape codes (AECs) no output, e tenho uma situação muito peculiar. De notar, estou a usar o Free Pascal 3.2.2.

Indo directo ao problema:

writeln( Ansify([BOLD, FG_RED], 'Fatality!') );
writeln( Ansify([ITALIC, FG(69)], 'Color Test, Standard') );
writeln( Ansify([UNDERLINE, BG(100, 50, 9)], 'Color Test, RGB') );

Quando executo este código de teste, a primeira chamada a Ansify funciona sem problemas. Contudo, a segunda chamada, independentemente do array que passo no primeiro argumento, dispara um Access Violation:

\x[1;31mFatality!\x[0m
An unhandled exception occurred at $00000000004124CA:
EAccessViolation: Access violation
  $00000000004124CA
  $00000000004243FC
  $00000000004011AB

Nota: forcei o output dos AECs para debugging durante o desevolvimento.

 

Esta é a definição de Ansify:

function Ansify(const codes : array of IAnsiCode; const msg : string) : string;
begin
    Result := Codify(codes) + msg + Codify([RESET]);
end;

Onde:

function Codify(const codes : array of IAnsiCode) : string;
var code : IAnsiCode;
begin
    Result := '\x[';
    // Result := ANSI_BEGIN;    // TODO: switch when finishing first version
    for code in codes do begin
        Result += code.AsString;
        Result += ANSI_SEPARATOR;
    end;
    Delete(Result, Length(Result), 1);
    Result += ANSI_END;
end;

 

A ideia é ter IAnsiCode como uma interface comum a duas classes que implementam AECs, mas que apenas obriga ao mínimo:

IAnsiCode = interface['{eeb511e3-0dbe-4fec-a72f-473f8bf8a8de}']
    function AsString : string;
    function AsByte : byte;
end;

Não estou a usar uma class function construtora que permita gerir automaticamente a libertação de recursos uma vez que posso precisar de qualquer código a qualquer momento por N vezes num programa, pelo que estou a alocar os objectos na inicialização do módulo e a "destruí-los" na finalização:

initialization
RESET := TAnsiCode.Create(0);
BOLD  := TAnsiCode.Create(1);
FAINT := TAnsiCode.Create(2);
// etc...

Aparentemente os objectos parecem ser todos destruídos após a primeira chamada a Ansify, tenham sido ou não usados na primeira chamada.

A classe TAnsiCode está definida da seguinte forma:

TAnsiCode = class(TInterfacedObject, IAnsiCode)
private
    vCode   : byte;
    vString : string;
    function WithCode(const code : byte) : IAnsiCode;
public
    constructor Create(const code : byte);
    function AsString : string;
    function AsByte : byte;
end;

 

A minha questão é simples: Por quê Access Violation? Para onde foram os objectos todos? 😄

Cumprimentos.

Edited July 24, 2023 at 10:15 AM by thoga31
Adição da definição da classe TAnsiCode

[nunopicado]

Bem, deixa lá ver se consigo juntar os únicos 2 neurónios que não tiraram férias para conseguir construir uma resposta mais ou menos inteligível. 😁

 

Uma AV é basicamente o compilador a dizer-te que algo ou não foi construído ou já foi libertado. Algo não existe. Até aí, já tinhas notado.

O que me parece que está a acontecer aí é que o uso de interfaces (recomendo sempre) funciona por reference count.
Ou seja, quando atribuis uma implementação de um interface a uma variável, o ref count faz +1.
Quando libertas, faz -1.
Quando o ref count for 0, automaticamente o objeto é libertado e bye bye Maria Ivone.

Quando crias o objeto na initialization, estás a fazer +1.
Quando o passas para dentro de Ansify e depois para Codify, tu imaginas que o compilador faça +1 por cada uma das funções. 
Mas, e atenção que estou a falar de cor, isso não acontece. Ao usares um array dinâmicos, estás implicitamente a passar a referência da posição de memória onde está o 'code'. Ou seja, o ref count continua, penso eu de que, em 1.
Quando termina a função e o array dinâmico é libertado, o endereço de memória que ele tem para libertar é o do objeto original. Ou seja, ao libertar o array, estás na prática a libertar os objetos nele contidos.

Arrays dinâmicos são dinossauros de outra época. Volta e meia dão jeito, atenção. Mas num mundo de interfaces, arrays dinâmicos são... não ideais. É preciso cuidado ao fazer esta mistura.

Agora, não sei é se tens, em FPC, alguma alternativa a isto. Podes tentar pesquisar por Collections, um termo genérico para este tipo de recurso. Sei que há uma TList, mas não sei ao certo como se comporta neste caso concreto.
Testa a TList para ver se serve o propósito, e tem em atenção pode favor que hoje estou todo frito, pelo que posso ter dado alguma calinada na resposta. 😂

[thoga31]

Mas todos os objectos que implementam aquela interface são libertados da memória em simultâneo? O facto de eles serem libertados aquando do array dinâmico faz todo o sentido, mas está-me a escapar o facto de irem todos de vela 😄

[nunopicado]

Em 24/07/2023 às 11:51, thoga31 disse:

Mas todos os objectos que implementam aquela interface são libertados da memória em simultâneo? O facto de eles serem libertados aquando do array dinâmico faz todo o sentido, mas está-me a escapar o facto de irem todos de vela 😄

hmmm
Todos, todos? Mesmo os que não usaste na primeira?

[thoga31]

Em 24/07/2023 às 11:53, nunopicado disse:

Todos, todos? Mesmo os que não usaste na primeira?

Sim! Na segunda linha, por exemplo, não usei nada da primeira, e crashou logo no ITALIC. Todos os objectos desaparecem 😕

 

[nunopicado]

Em 24/07/2023 às 11:09, thoga31 disse:

initialization
RESET := TAnsiCode.Create(0);
BOLD  := TAnsiCode.Create(1);
FAINT := TAnsiCode.Create(2);
// etc...

Qual a declaração de RESET, BOLD, FAINT, etc?

Faz um teste:
Colocar este código logo a seguir ao main BEGIN:

{$IFDEF DEBUG}
  ReportMemoryLeaksOnShutdown := True;
{$ENDIF}

Ao sair do programa, se houver leaks, ele vai-te avisar.

[thoga31]

Para quem usa Free Pascal, fica a dica do equivalente ao ReportMemoryLeaksOnShutdown:

{$mode delphi}
program test;
uses escape,
     heaptrc;     // <-- módulo necessário ao FPC e Lazarus

begin
    writeln( Ansify([BOLD, FG_RED], 'Fatality!') );
    writeln( Ansify([ITALIC], 'Color Test, Standard') );
    writeln( Ansify([BOLD, BG(100, 50, 9)], 'Color Test, RGB') );
    DumpHeap;     // <-- Mostra a heap no final do programa
end.

Este foi o resultado:

An unhandled exception occurred at $00000000004272CC:
EAccessViolation: Access violation
  $00000000004272CC
  $000000000042439F
  $0000000000401135

Heap dump by heaptrc unit of /home/user/dev/Escape/delphi/teste.bin
5 memory blocks allocated : 277/288
2 memory blocks freed     : 85/96
3 unfreed memory blocks : 192
True heap size : 458752 (12640 used in System startup)
True free heap : 445248
Should be : 445344
Call trace for block $00007FACE4135100 size 128
  $00000000004141E1
  $000000000042439F
  $0000000000401135
Call trace for block $00007FACE415D600 size 40
  $00000000004141E1
  $000000000042439F
  $0000000000401135
Call trace for block $00007FACE415D500 size 24
  $000000000042439F
  $0000000000401135

Tenho aqui uns memory leaks a resolver 😄

[nunopicado]

Faz uma experiência.

Em todas as classes que implementem um interface, cria algo como isto:

TAnsiCode = class(TInterfacedObject, IAnsiCode)
private
    vCode   : byte;
    vString : string;
    function WithCode(const code : byte) : IAnsiCode;
public
    constructor Create(const code : byte);
    class function New(const code : byte): IAnsiCode;
    function AsString : string;
    function AsByte : byte;
end;

// implementation

class function TAnsiCode.New(const code : byte): IAnsiCode;
begin
  Result := Create(code);
end;

E depois, ao construíres o objeto, em vez do create usas o new.
Isto obriga a criar uma variável que força o interface quando usado de forma implícita. Não creio, sinceramente, que seja esta a solução neste caso concreto, mas não custa tentar, além de que te resolve uma série de outros problemas ao usar interfaces.
 

[nunopicado]

Para o teu problema concreto, tenta criar uma lista, e libertar a lista numa secção finalization.
Crias também um enumerator, em vez daquelas variáveis RESET, BOLD, etc., cujos valores serão os do index do objeto na lista.

Depois, o array dinâmico não será do objeto, mas sim do enumerator.
Ao chamar, usas o valor do enumerator para aceder à lista e usar o objeto.

Creio que isso resolve, mas só tentando.

[thoga31]

Não sei o que fiz de diferente de quando tinha isso feito (tinha o New como indicaste, mas nem a primeira chamada ao Ansify funcionava), mas agora aparentemente está a funcionar.

Surgiu-me, contudo, um outro problema: as cores 😄 Defini desta forma a classe de cores:

TAnsiColor = class(TInterfacedObject, IAnsiCode)
private
    vCode   : byte;
    vString : string;
    vColor  : TAnsiColorRec;
    function WithCode(const code : byte) : IAnsiCode;
    procedure Reset;
public
    constructor Create(const code : byte);
    class function New(const code : byte) : IAnsiCode;
    function AsString : string;
    function AsByte : byte;
    function WithColor(const color : byte) : IAnsiCode; overload;
    function WithColor(const r, g, b : byte) : IAnsiCode; overload;
    function ColorMode : TAnsiColorEnum;
    function AsColor : TAnsiColorRec;
end;

 

Para usar as cores, estou a usar as funções e variáveis que se seguem:

interface
function FG(const color : byte)   : IAnsiCode; overload;
function FG(const r, g, b : byte) : IAnsiCode; overload;
function BG(const color : byte)   : IAnsiCode; overload;
function BG(const r, g, b : byte) : IAnsiCode; overload;

// ...
implementation
var _FG : IAnsiCode;
    _BG : IAnsiCode;

function FG(const color : byte) : IAnsiCode;
begin
    Result := TAnsiColor(_FG).WithColor(color);
end;

function FG(const r, g, b : byte) : IAnsiCode;
begin
    Result := TAnsiColor(_FG).WithColor(r, g, b);
end;

function BG(const color : byte) : IAnsiCode;
begin
    Result := TAnsiColor(_BG).WithColor(color);
end;

function BG(const r, g, b : byte) : IAnsiCode;
begin
    Result := TAnsiColor(_BG).WithColor(r, g, b);
end;

// ...
initialization
_FG := TAnsiColor.New(38);
_BG := TAnsiColor.New(48);

 

A chamada é feita, conforme visto na primeira mensagem, desta forma:

writeln( Ansify([ITALIC, FG(69)], 'Color Test, Standard') );
writeln( Ansify([UNDERLINE, BG(100, 50, 9)], 'Color Test, RGB') );

 

O compilador já me avisou que algo poderia correr mal nas funções FG e BG 😄

escape.pas(172,15) Warning: Class types "IAnsiCode" and "TAnsiColor" are not related
escape.pas(178,15) Warning: Class types "IAnsiCode" and "TAnsiColor" are not related
escape.pas(184,15) Warning: Class types "IAnsiCode" and "TAnsiColor" are not related
escape.pas(190,15) Warning: Class types "IAnsiCode" and "TAnsiColor" are not related

 

Ao executar, mais uma vez tenho Access Violation, mas desta vez entendo as possíveis causas. Contudo, estou sem ideias concretas de como posso fazer isto funcionar e continuar a ser minimamente simpático ao programador.

 

P.S.: Depois analisarei a possibilidade de usar uma TCollection, uma TList e/ou enumeradores.

[nunopicado]

Em 24/07/2023 às 13:52, thoga31 disse:

escape.pas(172,15) Warning: Class types "IAnsiCode" and "TAnsiColor" are not related
escape.pas(178,15) Warning: Class types "IAnsiCode" and "TAnsiColor" are not related
escape.pas(184,15) Warning: Class types "IAnsiCode" and "TAnsiColor" are not related
escape.pas(190,15) Warning: Class types "IAnsiCode" and "TAnsiColor" are not related

Hmmm. Isto geralmente acontece quando alguma variável está definida como TAnsiCode em vez de IAnsiCode.
Alguma assim?

[thoga31]

Em 24/07/2023 às 14:24, nunopicado disse:

Hmmm. Isto geralmente acontece quando alguma variável está definida como TAnsiCode em vez de IAnsiCode.
Alguma assim?

No typecast que fiz dentro das funções FG e BG 😄

[nunopicado]

Em 24/07/2023 às 14:31, thoga31 disse:

No typecast que fiz dentro das funções FG e BG 😄

Isso. Não tinha reparado (já te disse que estou a dormir hoje).
Para que foi o typecast? Se _FG e _BG já são IIAnsiCode, é uso direto.
Nem que não fosse, really. Usares o nome da classe em vez do interface põe por terra todo o uso de interfaces, e com isso, obriga-te a libertar a memória dessa chamada, pois deixa de ser ref counted nessa instancia.

 

[nunopicado]

Já percebi. Estás a usar um interface, mas não estás a colocar nele todos os métodos que vais usar.
Mas sendo assim, o interface está incorreto. É a mesma coisa que teres uma ficha LAN com PoE e alterares para transportar 220V no mesmo cabo. Vais acabar por fritar alguma coisa.

Uma mesma classe pode implementar vários interfaces, se quiseres, mas tens de ver depois como chamas cada um para teres acesso às funções corretas.

[thoga31]

Entretanto consegui resolver 😄

Primeiro, defini duas interfaces:

IAnsiCode = interface['{eeb511e3-0dbe-4fec-a72f-473f8bf8a8de}']
    function AsString : string;
    function AsByte : byte;
    function WithColor(const color : byte) : IAnsiCode; overload;
    function WithColor(const r, g, b : byte) : IAnsiCode; overload;
end;

IAnsiColor = interface['{a9f9f329-e69f-436c-b17f-ee0b962c1486}']
    function AsString : string;
    function ColorMode : TAnsiColorEnum;
    function AsColor : TAnsiColorRec;
end;

Como as cores podem sempre mudar, o que faço é modificar a vString do TAnsiCode com o método WithColor, o qual apenas se aplica caso seja um código válido:

function TAnsiCode.WithColor(const r, g, b : byte) : IAnsiCode; overload;
begin
    if self.vHasColor then
        with TAnsiColor.New(r, g, b) do
            self.vString := IntToStr(self.vCode) + ANSI_SEPARATOR + AsString;
    Result := self;
end;

A verificação é feita no construtor e é imutável após a alocação de recursos:

constructor TAnsiCode.Create(const code : byte);
begin
    self.vHasColor := code in VALID_ANSI_COLOR_CODES;
    self.WithCode(code);
end;

// onde:
VALID_ANSI_COLOR_CODES : set of byte = [38, 48];

 

Teste:

{$mode delphi}
program test;
uses escape;

begin
    writeln( Ansify([BOLD, FG_RED], 'Fatality!'), ' An error has not occurred! :(' );
    writeln( 'And here is a ', Ansify([ITALIC, FG(69)], 'Color Test, Standard'), '.' );
    writeln( Ansify([UNDERLINE, BG(100, 50, 9), ITALIC], 'Color Test, RGB'), ', and also ', Ansify([UNDERLINE, FG(9, 100, 50), ITALIC], 'Color Test, RGB') );
end.

Resultado:

 

Bem haja @nunopicado 🙂

Depois investigarei o possível uso de outra alternativa que não um array dinâmico, agradeço a sugestão.