yapt
16-01-2011, 16:11:32
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).
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).
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.....
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).
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).
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.....