Come assicurarsi del corretto rilascio delle risorse

[luigi67]

si scusa era senza parametro il create.
mi manca il getnext?

[Stilgar]

Codice: [Seleziona]

function TProdotto.getNext : TProdotto;
begin
  result := FNext;
end;

Non ricordo la shortcut .. ma c'è il modo di dire a Lazarus di fare il lavoro noioso al posto mio...
Crtl+O?
Possibbole?

Stilgar :p
OT: Inizio a sentire la primavera .. mo so affari vostri

[luigi67]

allora questo è il codice modificato della unit oggetti


unit oggetti;

{$mode objfpc}{$H+}{$M+}

interface

uses
   Classes, SysUtils;
type

{ TPianta }

TPianta=class(TObject)
private
 procedure SetNomePianta(AValue: String);
protected
FNomePianta:string;
Fnext:TPianta;
public
  Constructor Create;
  Destructor Destroy; override;
published
  Next : TPianta;
  property NomePianta: String read FNomePianta write SetNomePianta;
   end;

{ TProdotto }

TProdotto = class(TObject)
private
   procedure SetIDProdotto(AValue: String);
   procedure SetNext(AValue: Tprodotto);
   procedure SetNomePianta(AValue: String);
   procedure SetQuantita(AValue: Single);
 protected
   FNomePianta:string;
   FIDProdotto:string;
   FQuantita:single;
   FNext:TProdotto;
public
  Constructor Create;
  Destructor Destroy; override;

published

  property NomePianta: String read FNomePianta write SetNomePianta;
  property IDProdotto: String read FIDProdotto write SetIDProdotto;
  property Quantita : Single read FQuantita write SetQuantita;
  property Next:Tprodotto read FNext write SetNext;
 end;


implementation

{ TPianta }

procedure TPianta.SetNomePianta(AValue: String);
begin
   if NomePianta=AValue then Exit;
   FNomePianta:=AValue;
end;


constructor TPianta.Create;
begin
 FNomePianta:='';
end;

destructor TPianta.Destroy;
begin
  FNomePianta:='';
  if Assigned(FNext) then FreeAndNil(FNext);
  inherited Destroy;
end;


{ TProdotto}
procedure TProdotto.SetNomePianta(AValue: String);
begin
   if FNomePianta=AValue then Exit;
   FNomePianta:=AValue;
end;

procedure TProdotto.SetIDProdotto(AValue: String);
begin
   if FIDProdotto=AValue then Exit;
   FIDProdotto:=AValue;
end;

procedure TProdotto.SetNext(AValue: Tprodotto);
begin
   if Assigned(fNext) then
   begin
   fNext.Next := AValue;
   end
    else
    begin
      FNext := AValue
    end;
end;



procedure TProdotto.SetQuantita(AValue: Single);
begin
   if FQuantita=AValue then Exit;
   FQuantita:=AValue;
end;


constructor TProdotto.Create;
Begin
   FNomePianta:='';
   IDProdotto:='';
   FQuantita:=0.0;
   FNext:=nil;
End;

destructor TProdotto.Destroy;
Begin
   FNomePianta:='';
   IDProdotto:='';
   FQuantita:=0.0;
  if Assigned(FNext) then FreeAndNil(FNext);
  inherited Destroy;
End;
end.




e questo un frammento della  funzione che la richiama, chiaramente manca la creazione di next infatti alla seconda assegnazione fatta dal ciclo for mi da errore




function TFPrincipale.CaricaProdotti(var numprod:integer):TProdotto;
var
//corrente,precedente:PProdotti;
i:integer;
mempos:string;
prod:TProdotto;
begin
try
i:=1;
Result:=Nil;
prod:=TProdotto.Create;
numprod:= THackGrid(DBGRTrattProdotti).VisibleRowCount;

for i := 1 to numprod do al 2° ciclo errore su
begin
prod.IDProdotto:=dati.TTempTrattProdotti.FieldByName('Prodotto').AsString; 2° ciclo errore su
prod.Quantita:=dati.TTempTrattProdotti.FieldByName('FDQuantita').AsFloat;
prod:=prod.Next;
end;


......

[Stilgar]

Se non ti avesse dato errore mi sari incazzato con il compilatore...
Scommetto che si incazza perchè trova il valore NEXT non valorizzato.... o meglio valorizzato a pene segugiorum.

Codice: [Seleziona]

constructor TPianta.Create;
begin
 FNomePianta:='';
   FIDProdotto:='';
   FQuantita:=0.0.;
   FNext:=NIL;
 // Non facciamo gli scansafatiche, impostiamo TUTTI i volori di default a mano. ;) 
end;
//...
var TestaProdotti, ProdottoCursore : TProdotto;
//...
for i := 1 to numprod do //al 2° ciclo errore su
begin
  ProdottoCursore.IDProdotto:=dati.TTempTrattProdotti.FieldByName('Prodotto').AsString; 2° ciclo errore su
  ProdottoCursore.Quantita:=dati.TTempTrattProdotti.FieldByName('FDQuantita').AsFloat;
  ProdottoCursore := TProdotto.Create;  // <----- SE NON LI CREI NON LI USI :D SE LI USI E NON LI CREI ... Buuum
  TestaProdotti.Next := ProdottoCursore;
end;

Perdonato solo perchè stai riprendendo in mano la programmazione
Stilgar

OT: Come cantava?
Maledetta primavera?

[luigi67]

Grazie Stilgar
Adesso non posso provare la modifica, domani la prima cosa lo modifico. Ti devo dire che ci ero arrivato e ti invierò una copia di quello che ho fatto senza la tua modifica. Un'ultima cosa alla fine però perdo il riferimento alla lista; in pratica arrivo in fondo e basta... ho inserito una proprietà chiamata "first" che come da nome dovrebbe  mantenere il riferimento all'inizio della lista, ma poi mi sono ricordato che l'oggetto viene ricreato ogni volta di conseguenza... mi viene in mente "static" come reminescenza...mah

[luigi67]

allora di seguito la unit oggetto modificata. Mi manca come dicevo un passaggio e cioè il puntatore al primo elemento. In pratica riempo la lista  e poi perdo l riferimento.

Codice: [Seleziona]

unit oggetti;

{$mode objfpc}{$H+}{$M+}

interface

uses
   Classes, SysUtils;
type

{ TPianta }

TPianta=class(TObject)
private
 procedure SetNomePianta(AValue: String);
protected
FNomePianta:string;
Fnext:TPianta;
public
  Constructor Create;
  Destructor Destroy; override;
published
  Next : TPianta;
  property NomePianta: String read FNomePianta write SetNomePianta;
   end;

{ TProdotto }
TProdotto = class(TObject)
private
   function GetFirst: TPRodotto;
   procedure SetIDProdotto(AValue: String);
   procedure SetNext(AValue: Tprodotto);
   procedure SetNomePianta(AValue: String);
   procedure SetQuantita(AValue: Single);
   function  GetNext:TProdotto;
 protected
   FNomePianta:string;
   FIDProdotto:string;
   FQuantita:single;
   FNext:TProdotto;
   FFirst:TProdotto;
public
  Constructor Create;
  Destructor Destroy; override;

published

  property NomePianta: String read FNomePianta write SetNomePianta;
  property IDProdotto: String read FIDProdotto write SetIDProdotto;
  property Quantita : Single read FQuantita write SetQuantita;
  property Next:Tprodotto read GetNext write SetNext;
  property First:TPRodotto read GetFirst;
 end;


implementation

{ TPianta }

procedure TPianta.SetNomePianta(AValue: String);
begin
   if NomePianta=AValue then Exit;
   FNomePianta:=AValue;
end;


constructor TPianta.Create;
begin
 FNomePianta:='';
end;

destructor TPianta.Destroy;
begin
  FNomePianta:='';
  if Assigned(FNext) then FreeAndNil(FNext);
  inherited Destroy;
end;


{ TProdotto}
procedure TProdotto.SetNomePianta(AValue: String);
begin
   if FNomePianta=AValue then Exit;
   FNomePianta:=AValue;
end;

function TProdotto.GetFirst: TPRodotto;
begin
metodo vuoto dato che non riueco a capire come restituire il primo elemento della lista
end;

procedure TProdotto.SetIDProdotto(AValue: String);
begin
   if FIDProdotto=AValue then Exit;
   FIDProdotto:=AValue;
end;

procedure TProdotto.SetNext(AValue: Tprodotto);
begin
 if FNext=AValue then Exit;
 FNext:=AValue;
end;




procedure TProdotto.SetQuantita(AValue: Single);
begin
   if FQuantita=AValue then Exit;
   FQuantita:=AValue;
end;

function TProdotto.GetNext: TProdotto;
begin
FNext:=TProdotto.Create;
result := FNext;
end;


constructor TProdotto.Create;
Begin
   FNomePianta:='';
   IDProdotto:='';
   FQuantita:=0.0;
     FNext:=nil;
End;

destructor TProdotto.Destroy;
Begin
   FNomePianta:='';
   IDProdotto:='';
   FQuantita:=0.0;
  if Assigned(FNext) then FreeAndNil(FNext);
  inherited Destroy;
End;

end.

qui invece come viene richiamato l'oggetto

Codice: [Seleziona]

ProdottoCursore:=TProdotto.Create;
numprod:= THackGrid(DBGRTrattProdotti).VisibleRowCount;
//Getmem(prod,numprod*SizeOf(TProdotto) );
//inc(prod);
for i := 1 to numprod do
begin
ProdottoCursore.IDProdotto:=dati.TTempTrattProdotti.FieldByName('Prodotto').AsString;
ProdottoCursore.Quantita:=dati.TTempTrattProdotti.FieldByName('FDQuantita').AsFloat;
dati.TTempTrattProdotti.Next;
ProdottoCursore := TProdotto.Create;
TestaProdotti.Next := ProdottoCursore;

Sicuramente la soluzione è lì ma io per poca conoscenza di questi meccanismi non la vedo

[Stilgar]

Per vitare la perdita della lista, piccolo trucchetto.
Fai una funzione al posto di una procedura.
Quando la richiami, crea e popola la lista.
L'utilizzatore poi ha in mano la testa della lista e ne farà quello che deve

Codice: [Seleziona]

Function TContenitore.carica: TProdotto;
var 
  ProdottoCursore : TProdotto;
  numprod: integer;
begin
  ProdottoCursore := TProdotto.Create;
  Result :=  ProdottoCursore;
  ProdottoCursore:=TProdotto.Create;
  numprod:= THackGrid(DBGRTrattProdotti).VisibleRowCount;
  for i := 1 to numprod do
  begin
    ProdottoCursore.IDProdotto:=dati.TTempTrattProdotti.FieldByName('Prodotto').AsString;
    ProdottoCursore.Quantita:=dati.TTempTrattProdotti.FieldByName('FDQuantita').AsFloat;
    dati.TTempTrattProdotti.Next;
    ProdottoCursore := TProdotto.Create;
    Result.Next := ProdottoCursore;
  End;
End;

Altra considerazione.
Semplifichi la lettura, ma da designer ho sempre qualche dubbio
Questo oggetto è un oggetto di business, quindi potresti anche caricarlo della lettura e scrittuta sul dataset, a livello di competenze.

Quindi potresti mettere in piedi 2 metodilli carini.
Uno di lettura e uno di scrittura.

Codice: [Seleziona]

procedure TProdotto.LoadFromDataSet(const ds : TDataSet);
begin
  FIDProdotto := ds.FieldByName('Prodotto').asString;
  FQuantita:= ds.FieldByName('FDQuantita').asFloat;
end;


procedure TProdotto.SaveToDataSet(const ds : TDataSet);
begin
  try
  ds.edit;
  ds.FieldByName('Prodotto').asString := FIDProdotto ;
  ds.FieldByName('FDQuantita').asFloat := FQuantita;
  ds.post;
  except
  on E : Exception do
     raise EProdottoPersistenceServiceException .Create("Errore in salvataggio dei dati", e);
  end;
end;


Type
  EProdottoPersistenceServiceException = class(Exception)
   protected
     FCause : Exception;
   public 
      constructor Create(messageValue: String; causeValue : Exception=null);
      property Cause : Exception read FCause;
  end;


      constructor EProdottoPersistenceServiceException .Create(messageValue: String; causeValue : Exception);
      begin
         inherited Create(messageValue);
         FCause := causeValue;
      end;

Il getFirst nei nodi...a cosa ti serve?
Se ti serve a puntare alla testa della lista ...
Consumi ram per nulla.
Se vuole essere il nodo precedente, bene.
Non è una lista "semplice" ma "doppia" e mi torna

Stilgar

[Stilgar]

PS:
Tutto il codice lo scrivo di getto.
Non lo passo al compilatore


Stilgar

[luigi67]

Nente la lista si perde comunque. Se per maggiore precisione in ptatica richiamo la funzikone da un pulsante questo è il codice

Codice: [Seleziona]

procedure TFPrincipale.SpeedButton1Click(Sender: TObject);
var
recprod:TProdotto;
s:string;
begin
recprod:=CaricaProdotti;
s:=recprod.Next.IDProdotto;

la variabile s  vuota

Ti allego nuovamente tutto il codice
 

Codice: [Seleziona]

(*-----------------UNIT OGGETTI -----------*)

unit oggetti;

{$mode objfpc}{$H+}{$M+}

interface

uses
   Classes, SysUtils;
type

{ TPianta }

TPianta=class(TObject)
private
 procedure SetNomePianta(AValue: String);
protected
FNomePianta:string;
Fnext:TPianta;
public
  Constructor Create;
  Destructor Destroy; override;
published
  Next : TPianta;
  property NomePianta: String read FNomePianta write SetNomePianta;
   end;

{ TProdotto }
TProdotto = class(TObject)
private
   function GetFirst: TPRodotto;
   procedure SetIDProdotto(AValue: String);
   procedure SetNext(AValue: Tprodotto);
   procedure SetNomePianta(AValue: String);
   procedure SetQuantita(AValue: Single);
   function  GetNext:TProdotto;
 protected
   FNomePianta:string;
   FIDProdotto:string;
   FQuantita:single;
   FNext:TProdotto;
   FFirst:TProdotto;
public
  Constructor Create;
  Destructor Destroy; override;

published

  property NomePianta: String read FNomePianta write SetNomePianta;
  property IDProdotto: String read FIDProdotto write SetIDProdotto;
  property Quantita : Single read FQuantita write SetQuantita;
  property Next:Tprodotto read GetNext write SetNext;
  property First:TPRodotto read GetFirst;
 end;


implementation

{ TPianta }

procedure TPianta.SetNomePianta(AValue: String);
begin
   if NomePianta=AValue then Exit;
   FNomePianta:=AValue;
end;


constructor TPianta.Create;
begin
 FNomePianta:='';
end;

destructor TPianta.Destroy;
begin
  FNomePianta:='';
  if Assigned(FNext) then FreeAndNil(FNext);
  inherited Destroy;
end;


{ TProdotto}
procedure TProdotto.SetNomePianta(AValue: String);
begin
   if FNomePianta=AValue then Exit;
   FNomePianta:=AValue;
end;

function TProdotto.GetFirst: TPRodotto;
begin

end;

procedure TProdotto.SetIDProdotto(AValue: String);
begin
   if FIDProdotto=AValue then Exit;
   FIDProdotto:=AValue;
end;

procedure TProdotto.SetNext(AValue: Tprodotto);
begin
 if FNext=AValue then Exit;
 FNext:=AValue;
end;




procedure TProdotto.SetQuantita(AValue: Single);
begin
   if FQuantita=AValue then Exit;
   FQuantita:=AValue;
end;

function TProdotto.GetNext: TProdotto;
begin
FNext:=TProdotto.Create;
result := FNext;
end;


constructor TProdotto.Create;
Begin
   FNomePianta:='';
   IDProdotto:='';
   FQuantita:=0.0;
   FNext:=nil;
End;

destructor TProdotto.Destroy;
Begin
   FNomePianta:='';
   IDProdotto:='';
   FQuantita:=0.0;
  if Assigned(FNext) then FreeAndNil(FNext);
  inherited Destroy;
End;

end.



(*--------------------------Funzione Carica Prodotti------------------------*)



function TFPrincipale.CaricaProdotti:TProdotto;
var
mempos,s:string;
ProdottoCursore : TProdotto;
begin
   try
   ProdottoCursore := TProdotto.Create;
   Result :=  ProdottoCursore;
   dati.TTempTrattProdotti.DisableControls;
   dati.TTempTrattProdotti.Filtered:=true;
   dati.TTempTrattProdotti.First;
  while not dati.TTempTrattProdotti.eof do
       begin
        ProdottoCursore.IDProdotto:=dati.TTempTrattProdotti.FieldByName('Prodotto').AsString;
        ProdottoCursore.Quantita:=dati.TTempTrattProdotti.FieldByName('FDQuantita').AsFloat;
        dati.TTempTrattProdotti.Next;
        ProdottoCursore := TProdotto.Create;
        Result.Next := ProdottoCursore;
       end;
finally
dati.TTempTrattProdotti.Filtered:=False;
dati.TTempTrattProdotti.Locate('Prodotto',mempos,[]);
dati.TTempTrattProdotti.EnableControls;
end;
end;

[luigi67]

Ho fatto questa piccola modifica e funziona

Codice: [Seleziona]

while not dati.TTempTrattProdotti.eof do
       begin
       ProdottoCursore.IDProdotto:=dati.TTempTrattProdotti.FieldByName('Prodotto').AsString;
        ProdottoCursore.Quantita:=dati.TTempTrattProdotti.FieldByName('FDQuantita').AsFloat;
        dati.TTempTrattProdotti.Next;
     
    ProdottoCursore.Next := TProdotto.Create;
        ProdottoCursore:=ProdottoCursore.Next;

       end;
finally    

[Stilgar]

Bene

[luigi67]

Allora dopo prove e riprove l'errore persiste. La cosa pazzesca è che gli oggetti creati sono creati o dentro procedure con variabili locali o sono essi stessi result di funzioni. Eppure continua a darmi errore. Ho provato pure con backtrace ed è un'ulteriore conferma, la memoria non rilasciata cresce al maggior utilizzo di tali oggetti. es. se ho più di un record. Se ho un solo record backtrace mi dice

7 unfreed memory blocks : 126 

mentre se è di due record

12 unfreed memory blocks : 248

Vorrei allegare il progetto, ma per usarlo dovreste crearvi pure un database firebird, potrei allegare lo script sql per la creazione di un database vuoto

Il dubbio che mi viene è che sia un problema del compilatore o di Lazarus, dato che per usare alcuni package che mi servono li ho presi dalle versioni non stabili

e sono le seguenti

Lazarus 1.3 r43375
FPC 2.7.1 i386-linux-gtk 2

Vi ringrazio ancora per l'aiuto
Luigi

[Stilgar]

Prova a passare le istanze "locali" come parametri "var".
In questo modo non li hai creati nell'heap della funzione chimata, ma in quella chiamante.
Così il lifetime degli oggetti lo dovresti riuscire a controllare meglio .. spero.

Se poi il problema è nei pacchetti beta ... o li ricontrolli o cerchi una versione stabile per essere sicuro

Stilgar