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.....

[[coso]]

Hola,

creo que es debido a esto :

Código Delphi [-]
    Columna[x+1].Free;
    Columna[x+1] := nil;

De todas maneras, es mucho codigo para analizarlo detalladamente ahora saludos.

PD : mirando un poco mas...

Código Delphi [-]
for x := index to ColumnasActivas - 2 do
  begin
    Columna[x].Create( Columna[x+1] );
    Columna[x+1].Free;
    Columna[x+1] := nil;
  end;

no deberias asignar directamente? (Columna[x] := Columna[x+1]) sin el create, me refiero. De la manera que lo estas haciendo estas creando otra columna, o sea, que el antiguo puntero se pierde.

PDD : y mirandolo aun un rato mas : deberias no usar el free, sino hacer asignacion directa i liberar tansolo el ultimo.

Código Delphi [-]
for X := index to length(FColumnas) - 2 do
      FColumnas[x] := FColumnas[x+1];

FColumnas[length(FColumnas)-1].FreeAndNil;

setlength(FColumnas,Length(FColumnas)-1);

Creo que asi te funcionaria.

De la manera que lo hacias, creabas una columna (x+1) cuya propietaria era Columna(x), que acababas de liberar...(en teoria te tendria que petar tambien aqui, pues creas mediante columnas(index) que acababas de liberar ), por lo que te quedaba la columna(index) sin asignar, aunque las demas estuviesen bien. Por tanto, en el destroy te debia petar en el indice que se habia llamado con delcolumn. Un saludo.

[yapt]

Hola Coso, ante todo, muchas gracias por dedicar tu tiempo......

Empezado por coso

PD : mirando un poco mas...

Código Delphi [-]

for x := index to ColumnasActivas - 2 do
begin
Columna[x].Create( Columna[x+1] );
Columna[x+1].Free;
Columna[x+1] := nil;
end;


no deberias asignar directamente? (Columna[x] := Columna[x+1]) sin el create, me refiero. De la manera que lo estas haciendo estas creando otra columna, o sea, que el antiguo puntero se pierde.

Explico el motivo:

Justo antes del bucle FOR, lo primero que hago es liberar el objeto TDictionary ( Columna[index] ). Con lo que el nuevo Create, no debería dejar un objeto sin liberar (un Memory Leak).

Cada elemento del Array, en su forma Columna[x] referencia a cada uno de los objetos-lista genericos: TDictionary<>.
Según creo, la creación de una columna, pasando otra como parámetro debería hacer lo siguiente (en teoría):
1.- Crear una columna nueva (un nuevo objeto TDictionary, sin valores).
2.- Copiar los valores de la columna x+1 (un TDictionary) a la nueva columna x. Y digo copiar, no referenciar al otro objeto TDictionary.

Empezado por coso

PDD : y mirandolo aun un rato mas : deberias no usar el free, sino hacer asignacion directa i liberar tansolo el ultimo.


Código Delphi [-]
for X := index to length(FColumnas) - 2 do
FColumnas[x] := FColumnas[x+1];

FColumnas[length(FColumnas)-1].FreeAndNil;

setlength(FColumnas,Length(FColumnas)-1);


Creo que asi te funcionaria.

De la manera que lo hacias, creabas una columna (x+1) cuya propietaria era Columna(x), que acababas de liberar...

Uno de los constructores de TDictionary, acepta una Colección como parámetro. Por ejemplo, otro objeto TDictionary (que es como lo hacía). Este constructor, lo que hace es una copia (que no referencia) de uno al otro.

Siempre en teoria, claro. :-)


Con el código que indicas, creo que sucedería lo siguiente. Partiendo de esta situación hipotética de ejemplo:

Columna[0] = TDictionary con Pointer: 1000.
Columna[1] = TDictionary con Pointer: 1001.
Columna[2] = TDictionary con Pointer: 1002.

Siguiendo el bucle que expones y suponiendo que borramos la número 0, quedaría así:
Columna[0] = 1001
Columna[1] = 1002

Y liberamos el objeto que apunta a 1002 (la Columna[2]), con lo que yo creo que tenemos:

1.- Un memory leak para el objeto que estaba en 1000 (pues no se ha liberado).
2.- Un invalid Pointer en cuanto queramos acceder a Columna[1], pues el objeto que estaba en 1002, ha sido liberado.

Pero claro.... todo esto, insisto, es lo que yo creo.

Muchas gracias Coso.... :-)

[[Crandel]]

Tu codigo tiene muchos errores por varios lados.

Para eliminar varios al mismo tiempo te aconsejo utilizar la clase TList en vez de array dinámico.

Por otro lado al asignar los elementos tienes:

Código Delphi [-]
Value := TColumnaDict.Create;
  try
    AnadeValores(Value, 'uno', 'el uno', false);
    AnadeValores(Value, 'dos', 'el dos', true);
    FColMant.AddColumna(Value);
  finally
    Value.Free;
  end;

aca lo que estas haciendo es crear el objeto TColumnaDict asignarle valores y agregarlo a FColMant, hasta aca todo bien, pero luego lo destruyes !!!

Tienes que entender que Delphi al pasar objetos como parametros no crea una nueva instacia (copia) de ellos, sino solamente pasa el puntero, por lo que el objeto sigue siendo el mismo, asi que al destruirlo, destruiste el objeto que pasaste.

Donde obtienes el error es porque intentas de volver a destruir el objeto ya destruido

[yapt]

Empezado por Crandel

Tu codigo tiene muchos errores por varios lados.

Para eliminar varios al mismo tiempo te aconsejo utilizar la clase TList en vez de array dinámico.

Hola Crandel. Ya decia en mi primer mensaje que ya está funcionando correctamente usando una Lista (concretamente un TObjectList).

Agradecería, no obstante, saber cuales son esos errores.

Empezado por Crandel

Por otro lado al asignar los elementos tienes:

Código Delphi [-]
Value := TColumnaDict.Create;
  try
    AnadeValores(Value, 'uno', 'el uno', false);
    AnadeValores(Value, 'dos', 'el dos', true);
    FColMant.AddColumna(Value);
  finally
    Value.Free;
  end;

aca lo que estas haciendo es crear el objeto TColumnaDict asignarle valores y agregarlo a FColMant, hasta aca todo bien, pero luego lo destruyes !!!

Olvidas un paso:
FColMant.AddColumna(Value);

Este paso, copia la Colección a la nueva colección que se crea internamente, dentro de la clase.

Empezado por Crandel

Tienes que entender que Delphi al pasar objetos como parametros no crea una nueva instacia (copia) de ellos, sino solamente pasa el puntero, por lo que el objeto sigue siendo el mismo, asi que al destruirlo, destruiste el objeto que pasaste.

Donde obtienes el error es porque intentas de volver a destruir el objeto ya destruido

Gracias Crandel, creo que entiendo minimamente la forma de trabajo de Delphi y su paso de objetos.

Pero debo insistir, el "truco" de esta clase está en:

Código Delphi [-]
  if Value = nil then
    FColumnas[result] := TColumnaDict.Create
  else
    FColumnas[result] := TColumnaDict.Create(Value);

Donde la segunda forma de crear el objeto TColumnaDict, realiza una copia del objeto Value.

Si fuese de otro modo, en el test, el método:

Código Delphi [-]
 
TestValueAddedByTestAddColumna0

No funcionaría. Y si habeís pasado el test, todos ellos funcionan con normalidad (y he comprobado que sin ningún Memory Leak), excepto el método del TestCase:

Código Delphi [-]
 
TestDelColumnaStandAlone

y por tanto, el método de la clase:

Código Delphi [-]
    function DelColumna(index: Byte): Boolean;

Gracias por la respuesta..

Un saludo.

[[coso]]

Cierto, pense lo de mover los valores unicamente como si fuese un array simple. Gracias por la correcion.

Entonces deberia ser algo asi no?

Código Delphi [-]
FColumnas[index].FreeAndNil;

for X := index to length(FColumnas) - 2 do
FColumnas[x] := FColumnas[x+1];

setlength(FColumnas,Length(FColumnas)-1);

esto es, sin tener que recrear todo el array dentro del bucle, sino unicamente moviendo los ya existentes. Creo que ahora si es correcto...

PD: remirando tu codigo y habiendo leido lo que dices del create de TDictionary, creo que el error lo tienes en la linea del mismo. No se bien bien como va, pero me extraña que esta expresion (Columna[x].Create( Columna[x+1] )) funcione. No estas asignando nada a nada, solo llamando al create 'al aire', digamos, sin que se recoja su resultado (de todas maneras le echare un vistazo a la clase TDictionary). Si pruebas Columna[x] := TColumna.Create(Columna[x+1]) te falla tambien? Saludos.

[[Crandel]]

Coso ya encontró tu error asi que no hay mucho mas para dar vuelta, pero igual intento de explicar mejor a lo que me refería.

Empezado por yapt

Hola Crandel. Ya decia en mi primer mensaje que ya está funcionando correctamente usando una Lista (concretamente un TObjectList).

Agradecería, no obstante, saber cuales son esos errores.

No me refiero a que tienes errores del tipo que no compila o no te funcione. Me refiero al como esta implementado, principalmente al problema de crear componentes de forma permanente, tanto al insertar como en borrar, y seguramente en un futuro querras implementar insertar, mover, etc.

El proceso de creación de un objeto aunque es muy fácil para nosotros implementarlo es preferible no abusar de él. Ya que no solo consume mayor tiempo de ejecución sino que también el hecho de crear/borrar puede provocarte fragmentación de la memoria.

Es por eso que te recomendaba el uso la clase TList, hace exactamente lo que necesitas hacer pero ya optimizado por la gente de Delphi.