Jump to content

Recommended Posts

CONTEXT: (this is an analogy to make it easier to explain)

 

A class has a bunch of students. You keep their scores on a variety of required and optional assignments. Each one has a record with their name and a few scores in different categories.

 

<name>, <score#1>, <score#2>, <score#3>, <score#4>

 

I want to create a TListView that has one <name> line per student, and each column has a TOTAL of the scores for that column in all records with the same name. Some may only have one <name> record, and some might have 10, and any number in between.

 

It's rather clumsy to use the columns themselves to do the math (they're strings), so I made this object TSnapTally, to carry some integer fields that's attached to the .Data property where I update the numbers then update the line in the LV.

 

I'm having some problems with the TSnapTally instances either getting freed multiple times or NOT being freed (seems to be mostly the former).

 

So I defined an interface ISnapTally and derived class TSnapTally and I wanted to attach the interfaced object to the .Data property so that later on I can simply assign NIL to .Data and let the interface deal with deleting the instances.

 


In this code snippet, I'm looping over the contents of a TListview to see if the string deets[n] is in the LV's Caption column; if so, it assigns that TListItem to 'li' and also returns it. If not, li and returned value = NIL.

 

The first time it sees this name and it's not in the list, it adds a new item to the LV, sets the caption and four subitems, then assigns the newly created snap_tally to the .Data property.

 

Then I call TallyToListItem with the list item (li) that was either just created or already existed in the LV.

 

Here's the problem: 

 

At the top of TallyToListItem, it blows up when I assign li.Data to 'st' (of type ISnapTally). I don't understand why. It works fine if I use TSnapTally rather than ISnapTally.

 

 

This is Delphi 10.4.2, and li.Data is typed as a POINTER.

 

Can you not assign an Interfaced object instance to a POINTER? 

 

Maybe there's a better way to do this; I'm certainly open to suggestions.

 

      if not Assigned( ARDomainsLV_ItemWithCaption( deets[n], li ) ) then
      begin
        var snap_tally : ISnapTally;
        snap_tally := TSnapTally.Create( aSnap );
        li := AnalysisResultsDomains_lview.Items.Add;
        li.Caption := deets[n];
        li.SubItems.Add( '' );  // #detail recs
        li.SubItems.Add( '' );  // LM (1,2,3)
        li.SubItems.Add( '' );  // Org 1-10
        li.SubItems.Add( '' );  // Org 11-20
        li.Data := snap_tally;  // TSnapTally
      end;
      TallyToListItem( li, dom_deets, aSnap );
. . .
  procedure TallyToListItem( li : TListItem; aDomDeets : TDomainDetails; aSnap : TLSHMSnapshot );
  var st : ISnapTally;
  begin
    st := TSnapTally( li.Data );  <-- Blows up here
    st.IncNumDetailRecs;

 

 

Edited by David Schwartz

Share this post


Link to post

Assigning an interface to a pointer skips reference counting. Thus the instance behind snap_Tally is destroyed when leaving the scope (that's the end in your code snippet).

 

Next, when you retrieve li.Data, you cast it as TSnapTally despite the fact that you assigned an ISnapTally before (disregarding that the instance is already freed).

 

13 minutes ago, David Schwartz said:

I want to be able to simply set .Data to NIL later and have the object self-desruct when it's no longer being used.

That won't work either, because assigning nil to a Pointer doesn't trigger the reference counting even if there is an interface instance behind it.

 

I cannot test it in the moment, but you might succeed with the following approach:

      if not Assigned( ARDomainsLV_ItemWithCaption( deets[n], li ) ) then
      begin
        var snap_tally : ISnapTally;
        snap_tally := TSnapTally.Create( aSnap );
        li := AnalysisResultsDomains_lview.Items.Add;
        li.Caption := deets[n];
        li.SubItems.Add( '' );  // #detail recs
        li.SubItems.Add( '' );  // LM (1,2,3)
        li.SubItems.Add( '' );  // Org 1-10
        li.SubItems.Add( '' );  // Org 11-20
        ISnapTally(li.Data) := snap_tally; // this should add the ref count properly
      end;
      TallyToListItem( li, dom_deets, aSnap );
. . .
  procedure TallyToListItem( li : TListItem; aDomDeets : TDomainDetails; aSnap : TLSHMSnapshot );
  var st : ISnapTally;
  begin
    st := ISnapTally( li.Data ); // proper ref count
    st.IncNumDetailRecs;
. . .    
    ISnapTally( li.Data ) := nil; // proper ref count
    
    

For simplicity I would introduce a class helper for TListItem that captures all these castings:

type
  TListItemHelper = class helper for TListItem
    function GetSnapTally: ISnapTally;
    procedure SetSnapTally(Value: ISnapTally);
    property SnapTally: ISnapTally read GetSnapTally write SetSnapTally; 
  end;

function TListItemHelper.GetSnapTally: ISnapTally;
begin
  Result := ISnapTally(Data);
end;

procedure TListItemHelper.SetSnapTally(Value: ISnapTally);
begin
  ISnapTally(Data) := Value;
end;

 

  • Like 1

Share this post


Link to post

Great idea! Unfortunately, compiler doesn't like it:

10 minutes ago, Uwe Raabe said:

ISnapTally(li.Data) := snap_tally; // this should add the ref count properly

 

Compiler says:

 

[dcc32 Error] frmLSHM_Main.pas(1792): E2064 Left side cannot be assigned to

 

Ditto here:

procedure TListItemHelper.SetSnapTally(Value: ISnapTally);
begin
  ISnapTally(Data) := Value;  <-- Left side cannot be assigned to
end;

back to the same issue.

 

 

Edited by David Schwartz

Share this post


Link to post

@David

IMO you are mixing data with UI in a way that only causes problems. You should use a list class instance (nonvisual) to hold objects that represent a student, each of which holds a list of the classes taken with the score obtained. The list class can then have a method to compose the items for a listview you pass as parameter to the method. If you need that you can store the reference to the student object in the corresponding listitem's Data property, but the lifetime management of the objects is the duty of the list class, not that of the UI listview.

  • Like 5

Share this post


Link to post
23 minutes ago, PeterBelow said:

@David

IMO you are mixing data with UI in a way that only causes problems. You should use a list class instance (nonvisual) to hold objects that represent a student, each of which holds a list of the classes taken with the score obtained. The list class can then have a method to compose the items for a listview you pass as parameter to the method. If you need that you can store the reference to the student object in the corresponding listitem's Data property, but the lifetime management of the objects is the duty of the list class, not that of the UI listview.

Well, what I started out with was a list of one class, and there was just 1-3 records per student. Then I decided to combine classes, and the list got way too long. So I decided to split it into a sort of Master / Detail list where the top has a list of students, one line per student, with aggregate totals. When you click that, it displays all of the separate entries below for just that student. If you double-click, it takes those lower lines and sends them to another form to display them in a totally different way.

 

So this code is aggregating all of the individual lines on a per-student basis and trying to put them into the upper list.

 

I really don't care about what UI thing I use here. I just want a way to make it easier to manage what went from a fairly short list to a very long list when I combined all of this data together.

 

What about an in-memory dataset and a TDBGrid?

 

Edited by David Schwartz

Share this post


Link to post
1 hour ago, David Schwartz said:

Unfortunately, compiler doesn't like it:

Well, as I said, I couldn't test it.

 

Fortunately the class helper approach lets us implement a working solution at one place:

procedure TListItemHelper.SetSnapTally(Value: ISnapTally);
var
  I: ISnapTally;
  P: Pointer absolute I;
begin
  P := Data;
  I := Value;
  if Assigned(I) then
    I._AddRef; // because when I goes out of scope the refcount is decremented
  Data := P;
end;

 

  • Like 1

Share this post


Link to post

Uwe, that is ... UGLY!  Not your fault, it just stinks. I do appreciate the effort.

 

I'm going to try a couple of FDMemTables and DBGrids. So far it looks like it'll eliminate quite a bit of code, and just seems more natural and easier to manage.

Share this post


Link to post
5 minutes ago, David Schwartz said:

it just stinks

Storing an interface in a pointer stinks right from the beginning.

  • Haha 2

Share this post


Link to post
2 minutes ago, Uwe Raabe said:

Storing an interface in a pointer stinks right from the beginning.

Yup, it's just a bad approach that needs to be revised.

 

 

Edited by David Schwartz

Share this post


Link to post

 

Delphi in a nutshell - Ray Lischner - Nutshell.pas

Quote

.....

// Cast an interface to a Pointer such that the reference
// count is incremented and the interface will not be freed
// until you call ReleaseIUnknown.
function RefIUnknown(const Intf: IUnknown): Pointer;
begin
  Intf._AddRef;               // Increment the reference count.
  Result := Pointer(Intf);    // Save the interface pointer.
end;

 

// Release the interface whose value is stored in the pointer P.
procedure ReleaseIUnknown(P: Pointer);
var
  Intf: IUnknown;
begin
  Pointer(Intf) := P;
  // Delphi releases the interface when Intf goes out of scope.
end;

......

 

  • Thanks 1

Share this post


Link to post

To be honest I don't see the reason why interfaces are required here. If the objects are freed up multiple times that clearly indicates a coding issue; using interfaces for lifecycle management in this case seems a bit like duct tape on a totaled car.

 

I am also storing objects in .Data properties, using the OnDelete handler to manually free these up and set the .Data to nil. Never had a single issue with multiple release attempts or leaks (except if VCL styles are active but that's a different topic).

 

Out of curiosity you can add a FreeNotification handler and put a breakpoint in that. That way you could examine what is freeing your objects up when you don't want them to, yet.

  • Thanks 1

Share this post


Link to post

Why don't you use the TListView in Virtual mode (OwnerData := True)?
Use the OnData event with Item.Index as your index and use an objectList like


 TStudentList = TObjectList<TStudent>;

 

 get the data from this list, for example:

procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
begin
    var lStudent := glbStudentList[ Item.Index ];
    Item.Caption := lStudent.Name;
    Item.Subitems.Add(''); // lStudent.Score1 ?
    Item.Subitems.Add(''); // lStudent.Score2 ?
    Item.Subitems.Add(''); // lStudent.Score3 ?
    Item.Subitems.Add(''); // Total ?
end;

 

Remember to "feed" your listview using the count property:

MyListVview.Items.Count := glbStudentList.Count;


This assignment is required everytime you add or remove a student from the list.

 

  • Like 1
  • Thanks 1

Share this post


Link to post
7 hours ago, aehimself said:

To be honest I don't see the reason why interfaces are required here. If the objects are freed up multiple times that clearly indicates a coding issue; using interfaces for lifecycle management in this case seems a bit like duct tape on a totaled car.

 

Well, at this point I'm mostly in agreement with you. I haven't been able to get the memory manager to work in Sidney edition at all, and I normally use it to track down memory leaks. Without it, the best I can do is figure out where things are being created, but not where they're being freed or corrupted/overwritten unintentionally. This particular construct started out as a hack and it has been a problem from the start. I'm not sure why. 

 

But the in-memory table will be far more robust and less code overall, and I won't need to deal with dynamically created objects at all. I should have gone with it first.

 

It can be hard when you go down the wrong path and feel so invested in it that you don't want to give it up. But this only getting worse and it's time to chuck it for something better.

 

Share this post


Link to post
1 minute ago, David Schwartz said:

Well, at this point I'm mostly in agreement with you. I haven't been able to get the memory manager to work in Sidney edition at all, and I normally use it to track down memory leaks.

Would you elaborate that?

Memory manager works fine in Sydney and detects memory leaks.

Share this post


Link to post
13 minutes ago, Dalija Prasnikar said:

Memory manager works fine in Sydney and detects memory leaks.

Yes, but it's not pinpointing the line in the source code where the leaked object was created like as DeLeaker / FastMM full does. My main application which is about 1M LOC, you tell me a class name and I can tell where and why it was created. In older, legacy applications this can be a nightmare, especially if - like at work - everyone uses a TStringList instance for text manipulation, data storage or even as a parameter for a function call.

 

I guess this is what @David Schwartz meant. In these occasions, having the complete callstack of a leaked object is a life saver.

Share this post


Link to post

FastMM is what I was referring to. I have not been able to get either of the two most recent V4 versions to work properly in Sidney. It works fine in Tokyo. I've brought it up here before, and apparently it's unique to my machine since nobody else seems to have a problem.

 

I built a tool for it that parses out the log file and makes it super easy to figure out the likely source of the error. Most of the stuff in the log file is redundant, and it's mostly documenting side-effects of the error, not the error itself.

 

Eg, failing to free the Objects in a stringlist throws a gazillion errors related to all of the orphaned objects, making it really hard to figure out that the problem was with the stringlist, which technically did nothing wrong. 

 

Also, in some situations, I'll get tons of orphaned string literals showing up that baffle me why they're even there. I forgot to properly free something that had a bunch of strings in it, and I guess Unicode sometimes gets them from the heap when they're added to certain containers (?). It's all just noise!

 

In most cases, it comes down to missing one single call to .Free somewhere before either replacing something or freeing the container.

 

 

Edited by David Schwartz

Share this post


Link to post
6 hours ago, David Schwartz said:

FastMM is what I was referring to. I have not been able to get either of the two most recent V4 versions to work properly in Sidney. It works fine in Tokyo. I've brought it up here before, and apparently it's unique to my machine since nobody else seems to have a problem.

 

I built a tool for it that parses out the log file and makes it super easy to figure out the likely source of the error. Most of the stuff in the log file is redundant, and it's mostly documenting side-effects of the error, not the error itself.

 

Eg, failing to free the Objects in a stringlist throws a gazillion errors related to all of the orphaned objects, making it really hard to figure out that the problem was with the stringlist, which technically did nothing wrong. 

 

Also, in some situations, I'll get tons of orphaned string literals showing up that baffle me why they're even there. I forgot to properly free something that had a bunch of strings in it, and I guess Unicode sometimes gets them from the heap when they're added to certain containers (?). It's all just noise!

 

In most cases, it comes down to missing one single call to .Free somewhere before either replacing something or freeing the container.

I cannot say whether something in logs changed, but as far as I can remember FastMM works in Sidney the same way it worked before. I don't have the Tokyo installed for comparison. And it shows the stack trace correctly so I can follow to the line where issue happened.

Yes, I know that in more complex code it can be harder to figure out real culprit, but that has always been the case.

Share this post


Link to post

I use the following approach (out of my memory):

type  
    TSnapTallyWrapper = TInterfaceWrapper<ISnapTally>;

begin
    li.Data := TSnapTallyWrapper.Create(snap_tally);
    //...
    ISnapTally Test := TSnapTallyWrapper(li.Data).Intf;
    //...
    Free(li.Data);
    li.Data := nil;
end;

with

TInterfaceWrapper<T: IInterface> = class(TObject)
private
    FIntf: T;
public
    constructor Create(AIntf: T);
    property Intf: T read FIntf write FIntf;
end;

//...

constructor TInterfaceWrapper<T>.Create(AIntf: T);
begin
    inherited Create;
    FIntf := AIntf;
end;

No tricks. Clean references.
   

Share this post


Link to post

Uwe, I've been meaning to thank you for this. Not for anything related to the Interface, per se, but it solves a problem I've encountered many times in the past dealing with the fact that these TListItem.Data members are Pointers rather than Objects, and they get gnarly to deal with because you constantly have to cast them. Sometimes I cast them improperly and sometimes they get deleted or orphaned unintentionally.

 

Here just pretend that ISnapTally is really TSnapTally, and that's really just some type <T> that I happen to be working with.

 

In this case, I thought creating an interface would make managing the Data members easier, but it didn't.

 

What I ended up doing was creating a TListItemHelper class that has three different "overlays" for the Data member depending on context.

 

(Different ListViews save different objects in their Data members. Since you can only have one helper per class, I just put support for all three types into the helper, since the TListItem is unrelated to the ListView that's holding the data. I mean, I could derive different ListViews but the TListItem is the same for all of them; it isn't easily subclassed to override the type of the Data element depending on the ListView. So while this is not a very elegant solution, it's simple and it works nicely.)

 

However, what I did to solve the persistency issues was I created a separate TList<TSnapTally> and called it SnapTallyBag. Then modified the Set and Get to work indirectly by saving the index into the list as the value of the Data item, rather than a pointer to the item itself. I simply add stuff to the bag, doing a test for existing instances so there are no duplicates. And I never delete anything until I get to a point where I need to clear the ListView, then I just flush the contents of the bag. When the form closes, if it's not empty, then I flush it at that point as well.

 

It just never occurred to me to use a class helper this way. So that's what I got from this, and it was far more helpful than the Interface hack. 🙂 

 

In fact, I ended up ditching the use of the Interface, and all of the other issues I was having disappeared with this approach.

 

On 1/13/2022 at 3:43 AM, Uwe Raabe said:

type
  TListItemHelper = class helper for TListItem
    function GetSnapTally: ISnapTally;
    procedure SetSnapTally(Value: ISnapTally);
    property SnapTally: ISnapTally read GetSnapTally write SetSnapTally; 
  end;

function TListItemHelper.GetSnapTally: ISnapTally;
begin
  Result := ISnapTally(Data);
end;

procedure TListItemHelper.SetSnapTally(Value: ISnapTally);
begin
  ISnapTally(Data) := Value;
end;

 

 

 

Edited by David Schwartz
  • Like 1

Share this post


Link to post
Guest

I think that no need so much for this task!

 

var
  MyFS: TFormatSettings;

procedure TForm1.Button1Click(Sender: TObject);
var
  LIBefore    : TListItem;
  LINext      : TListItem;
  LIStudent   : TListItem;
  i           : integer;
  StudentTotal: double;
begin
  i         := -1;
  LIBefore  := nil;
  LINext    := nil;
  LIStudent := nil;
  //
  StudentTotal := 0.00;
  //
  LIBefore := ListView1.Items[0];
  //
  repeat
    inc(i);
    LINext := ListView2.Items[i];
    //
    if not(LIBefore = nil) and not(LINext = nil) then
    begin
      if not(LIBefore.Caption = LINext.Caption) then
        StudentTotal := 0.00;
      //
      begin
        LIStudent := ListView1.FindCaption(0, LINext.Caption, false, true, true);
        //
        if not(LIStudent = nil) then
          StudentTotal := StudentTotal + StrToFloatDef(LINext.SubItems[1], 0, MyFS);
        //
        LIStudent.SubItems[0] := StudentTotal.ToString;
      end;
    end;
    //
    LIBefore := LINext;
    //
  until (LINext = nil);
end;

 

procedure TForm1.FormCreate(Sender: TObject);
var
  LI: TListItem;
begin
  LI         := ListView1.Items.Add;
  LI.Caption := 'David';
  LI.SubItems.Add('0.0');
  //
  LI         := ListView1.Items.Add;
  LI.Caption := 'Alisson';
  LI.SubItems.Add('0.0');
  //
  LI         := ListView1.Items.Add;
  LI.Caption := 'john';
  LI.SubItems.Add('0.0');
  //
  LI         := ListView1.Items.Add;
  LI.Caption := 'mary';
  LI.SubItems.Add('0.0');
  //
  LI         := ListView2.Items.Add;
  LI.Caption := 'john';
  LI.SubItems.Add('math');
  LI.SubItems.Add('7.2');
  //
  LI         := ListView2.Items.Add;
  LI.Caption := 'mary';
  LI.SubItems.Add('geography');
  LI.SubItems.Add('6.7');
  LI         := ListView2.Items.Add;
  LI.Caption := 'mary';
  LI.SubItems.Add('english');
  LI.SubItems.Add('9.3');
  //
  LI         := ListView2.Items.Add;
  LI.Caption := 'Alisson';
  LI.SubItems.Add('geography');
  LI.SubItems.Add('5.0');
  //
  ListView2.SortType := TSortType.stText; // indexed for found equals value on "Caption"
end;

initialization

MyFS                  := TFormatSettings.Create;
MyFS.DecimalSeparator := '.';

end.

 

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×