Array dinamico e invalid pointer operation.

[yapt]

Hola a todos,

estoy haciendo una clase que trata de mantener listas de Claves/Valor (siendo Valor, un record de 2 campos).

Envío la clase entera (no es muy grande) junto con una indicación del lugar donde se produce el Invalid Pointer (buscar ERROR).

Seguir leyendo al final del código de la clase (adjunto test donde se produce el error).

Código Delphi [-]
unit uClassColMan;
 
interface
 
uses
  SysUtils, Generics.Collections;
 
type
  RValor = record
    Valor: string;
    Dif: Boolean;
  end;
 
  TColumnaDict = TDictionary<string, RValor>;
 
  TColMant = class
  strict private
    FColumnas : array of TColumnaDict;
  private
    function GetColumnasActivas: Byte;
    function GetFColumnas(Index: Byte): TColumnaDict;
    procedure SetFColumnas(Index: Byte; const Value: TColumnaDict);
  public
    destructor Destroy; override;
    function AddColumna(Value: TColumnaDict): Byte;
    function DelColumna(index: Byte): Boolean;
    property ColumnasActivas: Byte read GetColumnasActivas;
    property Columna[Index: Byte] : TColumnaDict read GetFColumnas write SetFColumnas;// default;
  end;
 
implementation
 
 
{ TColMant }
 
function TColMant.AddColumna(Value: TColumnaDict): Byte;
var
  s : string;
  f : RValor;
begin
  result := Length(FColumnas);
  if result = High(Byte) then
    raise Exception.Create('No se pueden añadir más columnas.  Se ha superado el límite');
  SetLength(FColumnas, result + 1);
  if Value = nil then
    FColumnas[result] := TColumnaDict.Create
  else
    FColumnas[result] := TColumnaDict.Create(Value);
end;
 
function TColMant.DelColumna(index: Byte): Boolean;
var
  x: Integer;
begin
  result := False;
  if index >= length(FColumnas) then
    raise Exception.Create('Ha especificado un número de columna '+InttoStr(index)+', que es mayor'+#13+
                           'que las columnas que existen en la Clase: '+ IntToStr(Length(FColumnas)));
  // Borramos columna.
  Columna[index].Free;
  // Movemos las columnas para ocupar el sitio de la borrada.
  for x := index to ColumnasActivas - 2 do
  begin
    Columna[x].Create( Columna[x+1] );
    Columna[x+1].Free;
    Columna[x+1] := nil;
  end;
  SetLength(FColumnas, length(FColumnas)-1 );
  Result := True;
end;
 
destructor TColMant.Destroy;
var
  x: Integer;
begin
  for x := 0 to ColumnasActivas-1 do
  begin
    FColumnas[x].Free;     // <<<<------   ERROR invalid pointer operation.
    FColumnas[x] := nil;
  end;
  SetLength(FColumnas, 0);
  FColumnas := nil;
  inherited;
end;
 
function TColMant.GetColumnasActivas: Byte;
begin
  result := Length(FColumnas);
end;
 
function TColMant.GetFColumnas(Index: Byte): TColumnaDict;
begin
  result := FColumnas[Index];
end;
 
procedure TColMant.SetFColumnas(Index: Byte; const Value: TColumnaDict);
begin
  FColumnas[Index] := Value;
end;
 
end.

Dejo también el conjunto de Tests (usando DUnit framework) que estoy utilizando para probar la clase. El error se produce en el método TearDown del TestCase. Es decir, en la destrucción de la clase objeto del Test.

Lo malo del asunto es que solo se produce en la ejecución del TearDown para el test: TestDelColumnaStandAlone (Como podreis comprobar si ejecutais el TestCase).

Código Delphi [-]
unit TestuClassColMan;
{
  Delphi DUnit Test Case
  ----------------------
  This unit contains a skeleton test case class generated by the Test Case Wizard.
  Modify the generated code to correctly setup and call the methods from the unit
  being tested.
}
 
interface
 
uses
  TestFramework, SysUtils, Generics.Collections, uClassColMan;
 
type
  // Test methods for class TColMant
  TestTColMant = class(TTestCase)
  strict private
    FColMant: TColMant;
  strict private
    procedure AnadeValores(var ValCol: TColumnaDict; wKey, wValor: string; wDif: Boolean);
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAddColumnaStandAlone;
    procedure TestDelColumnaStandAlone;
    procedure TestAddColumnasVaciasStandAlone;
    procedure TestColumnasActivas;
    procedure TestValueAddedByTestAddColumna0;
    procedure TestValueAddedByTestAddColumna1;
  end;
 
 
implementation
 
procedure TestTColMant.AnadeValores(var ValCol: TColumnaDict; wKey, wValor: string;
  wDif: Boolean);
var
  Valor: RValor;
begin
  Valor.Valor := wValor; Valor.Dif := wDif;
  ValCol.Add(wKey, Valor);
end;
 
procedure TestTColMant.SetUp;
var
  Value: TColumnaDict;
begin
  FColMant := TColMant.Create;
  Value := TColumnaDict.Create;
  try
    AnadeValores(Value, 'uno', 'el uno', false);
    AnadeValores(Value, 'dos', 'el dos', true);
    FColMant.AddColumna(Value);
  finally
    Value.Free;
  end;
  Value := TColumnaDict.Create;
  try
    AnadeValores(Value, '1Pepe', 'el uno', false);
    AnadeValores(Value, '2Juan', 'el dos', true);
    FColMant.AddColumna(Value);
  finally
    Value.Free;
  end;
end;
 
procedure TestTColMant.TearDown;
begin
  FColMant.Free;
  FColMant := nil;
end;
 
procedure TestTColMant.TestAddColumnaStandAlone;
const
  Esperado = 3;  // Porque el Setup ya crea algunas.
var
  Value: TColumnaDict;
  Columnas, ColumnaCreada: Byte;
begin
  Value := TColumnaDict.Create;
  try
    AnadeValores(Value, 'primera', '111', true);
    AnadeValores(Value, 'segunda', '222', false);
    ColumnaCreada := FColMant.AddColumna(Value);
    Columnas      := FColMant.ColumnasActivas;
  finally
    FreeAndNil(Value);
  end;
  Check(Columnas = Esperado, 'Debería devolver '+InttoStr(Esperado)+' columnas, pero devuelve ' + IntToStr(Columnas));
end;
 
procedure TestTColMant.TestAddColumnasVaciasStandAlone;
const
  Esperado = 4;  // Porque el Setup ya crea algunas.
var
  r    : RValor;
  Columnas, ColumnaCreada: Byte;
begin
  r.Valor := 'aaa';
  r.Dif   := true;
  ColumnaCreada := FColMant.AddColumna(nil);
  Columnas      := FColMant.ColumnasActivas;
  FColMant.Columna[ColumnaCreada].Add('prueba', r);
  Check(Columnas = Esperado - 1, 'Debería devolver '+InttoStr(Esperado-1)+' columna, pero devuelve ' + IntToStr(Columnas));
  ColumnaCreada := FColMant.AddColumna(nil);
  Columnas      := FColMant.ColumnasActivas;
  Check(Columnas = Esperado, 'Debería devolver '+InttoStr(Esperado)+' columnas, pero devuelve ' + IntToStr(Columnas));
end;
 
procedure TestTColMant.TestColumnasActivas;
const
  Esperado = 2;
var
  ReturnValue: Byte;
begin
  ReturnValue := FColMant.ColumnasActivas;
  Check(ReturnValue = Esperado, 'Debería devolver '+IntToStr(Esperado)+' columnas, devuelve ' + IntToStr(ReturnValue));
end;
 
procedure TestTColMant.TestDelColumnaStandAlone;
const
  EsperadoRes = true;
  EsperadasCol= 2-1;
var
  ObtenidoRes: Boolean;
  ObtenidasCol: Byte;
begin
  ObtenidoRes := FColMant.DelColumna(0);
  ObtenidasCol := FColMant.ColumnasActivas;
  Check(ObtenidasCol = EsperadasCol, 'Ok');
  Check(ObtenidoRes = EsperadoRes, 'Deberia haber sido true.');
end;
 
procedure TestTColMant.TestValueAddedByTestAddColumna0;
begin
  Check(FColMant.Columna[0].Items['uno'].Valor = 'el uno', 'El uno debería ser ''el uno''');
  Check(FColMant.Columna[0].Items['uno'].Dif   = false   , 'El uno debería ser ''false''');
  Check(FColMant.Columna[0].Items['dos'].Valor = 'el dos', 'El dos debería ser ''el dos''');
  Check(FColMant.Columna[0].Items['dos'].Dif   = true    , 'El dos debería ser ''true''');
end;
 
procedure TestTColMant.TestValueAddedByTestAddColumna1;
begin
  Check(FColMant.Columna[1].Items['1Pepe'].Valor = 'el uno', 'El 1Pepe debería ser ''el uno''');
  Check(FColMant.Columna[1].Items['1Pepe'].Dif   = false   , 'El 1Pepe debería ser ''false''');
  Check(FColMant.Columna[1].Items['2Juan'].Valor = 'el dos', 'El 2Juan debería ser ''el dos''');
  Check(FColMant.Columna[1].Items['2Juan'].Dif   = true    , 'El 2Juan debería ser ''true''');
end;
 
initialization
  // Register any test cases with the test runner
  RegisterTest(TestTColMant.Suite);
end.

En este momento lo tengo funcionando correctamente, ya que he modificado la clase para usar un TList en lugar de un Array dinámico. Pero tengo una enorme curiosidad por saber que estaba haciendo mal. Seguro que es muy evidente.

El método: DelColumna que es el que genera el error (eso creo), pretende que se pueda borrar una "columna", y ajustar el resto de forma consecutiva. Es decir, si tengo 3 columnas (0, 1 y 2) y borramos la columna 0 (DelColumna(0)), las columnas deberían quedar:
2 columnas = (0,1) ..... siendo estas 0 y 1, las antiguas 1 y 2.

Bueno, gracias.....