Platforms to show: All Mac Windows Linux Cross-Platform

/Main/Leak Finder


Required plugins for this example: MBS Util Plugin

You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Main/Leak Finder

This example is the version from Sat, 7th May 2021.

Project "Leak Finder.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
End Class
Class LeakFinderWindow Inherits Window
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
End Control
Control MyPushButton1 Inherits MyPushButton
ControlInstance MyPushButton1 Inherits MyPushButton
EventHandler Sub Action() End EventHandler
End Control
Control List Inherits Listbox
ControlInstance List Inherits Listbox
End Control
EventHandler Sub Open() #If DebugBuild Then // some test objects Dim d As New Dictionary Dim a() As Variant a.Append new pair(2,d) Dim p As New pair(1,a) // dictionary -> pair -> array -> pair -> same Dictionary // make a leak to window MyPushButton1.SetWin Self // make a leak to pair d.Value(1) = p MenuItems.Append new MenuItem db = New SQLiteDatabase If db.Connect Then rec = db.SQLSelect("select 1+2") End If dic = d d.Value(db) = rec Dim t As New TestWindow // this label reference is dead when the window closes in next line! Dim l As label = t.Label1 t.Close t = nil #EndIf // find leaks now, shows leaks made above FindLeaks End EventHandler
Sub FindLeaks() Dim M As New LeakFinder AddHandler m.FoundLeak, WeakAddressOf FoundLeak m.FindLeaks End Sub
Sub FoundLeak(f as LeakFinder, Path() as LeakObject) Dim names() As String For Each o As LeakObject In path names.Append o.ClassName Next list.AddRow Join(names, " -> ") End Sub
Property db As database
Property dic As Dictionary
Property menuItems() As MenuItem
Property rec As RecordSet
Property test(2) As Variant
Property test2(2,2) As Variant
Property test3(2,2,2) As Variant
End Class
MenuBar MainMenuBar
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem EditSeparator1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem EditSeparator2 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
Class MyPushButton Inherits PushButton
Sub SetWin(w as window) Self.win = w End Sub
Property Private win As window
End Class
Class LeakObject
ComputedProperty ClassName As string
Sub Get() Return Introspection.GetType(target).name End Get
End ComputedProperty
Sub AddReference(LeakFinder as LeakFinder, value as Variant) // ignore a few things. Same code in AddObject and AddReference // ignore ourselves If value IsA leakfinder Then Return If value IsA leakobject Then Return // ignore introspection If value IsA Introspection.AttributeInfo Then Return If value IsA Introspection.ConstructorInfo Then Return If value IsA Introspection.MemberInfo Then Return If value IsA Introspection.MethodInfo Then Return If value IsA Introspection.ParameterInfo Then Return If value IsA Introspection.PropertyInfo Then Return If value IsA Introspection.TypeInfo Then Return // ignore data classes #if XojoVersion >= 2020 then If value IsA Xojo.Rect Then Return If value IsA Xojo.Size Then Return If value IsA Xojo.Point Then Return If value IsA dateTime Then Return If value IsA TimeZone Then Return #EndIf If value IsA WeakRef Then Return If value IsA date Then Return If value IsA MemoryBlock Then Return // skip if we find our own stuf here If value Is LeakFinder.Objects Then Return End If If value Is references Then Return End If // now add objects Dim vt As Integer = VarType(value) If vt = Variant.TypeObject Or vt = (Variant.TypeArray Or Variant.TypeObject) Then Dim l As LeakObject = LeakFinder.Objects.Lookup(value, Nil) If l <> Nil Then references.Append l Else // add missings Dim n As LeakObject = LeakFinder.AddObject(value) If n <> Nil Then references.Append n Else Break End If End If End If End Sub
Sub Constructor(value as Variant) self.target = value End Sub
Sub clear() references = Nil End Sub
Property references() As LeakObject
Property target As variant
Property visited As Boolean
End Class
Class LeakFinder
Event FoundLeak(Path() as LeakObject) End Event
Sub AddAllObjects() Dim o As Runtime.ObjectIterator = Runtime.IterateObjects While o.MoveNext Call AddObject o.Current Wend Processed = False End Sub
Function AddObject(value as variant) As LeakObject // ignore a few things. Same code in AddObject and AddReference // ignore ourselves If value IsA leakfinder Then Return Nil If value IsA leakobject Then Return Nil // ignore introspection If value IsA Introspection.AttributeInfo Then Return Nil If value IsA Introspection.ConstructorInfo Then Return Nil If value IsA Introspection.MemberInfo Then Return Nil If value IsA Introspection.MethodInfo Then Return Nil If value IsA Introspection.ParameterInfo Then Return Nil If value IsA Introspection.PropertyInfo Then Return Nil If value IsA Introspection.TypeInfo Then Return Nil // ignore data classes #If XojoVersion >= 2020 Then If value IsA Xojo.Rect Then Return Nil If value IsA Xojo.Size Then Return Nil If value IsA Xojo.Point Then Return Nil If value IsA dateTime Then Return Nil If value IsA TimeZone Then Return Nil #endif If value IsA WeakRef Then Return Nil If value IsA date Then Return Nil If value IsA MemoryBlock Then Return Nil If value Is objects Then Return Nil // now store this one Dim l As New LeakObject(value) objects.value(value) = l Processed = False Return l End Function
Sub Clear() For Each v As Variant In Objects.Keys If v IsA LeakObject Then Dim obj As LeakObject = v obj.clear end if Next objects.Clear End Sub
Private Sub ClearVisited() Dim objectsValues() As Variant = objects.values For Each obj As LeakObject In objectsValues obj.visited = False Next End Sub
Sub Constructor() objects = New Dictionary End Sub
Sub Destructor() // clear anything if there is something left For Each obj As LeakObject In objects.values obj.clear Next End Sub
Sub FindLeaks() // no objects, so add them all! If objects.Count = 0 Then AddAllObjects End If // process if not yet done If Not Processed Then Process End If Dim FoundPath() As LeakObject Dim objectsValues() As Variant = objects.values For Each obj As LeakObject In objectsValues Redim FoundPath(-1) ClearVisited Dim found As Boolean = FindLeaksIn(obj, FoundPath) If found Then FoundPath.Append obj RaiseEvent FoundLeak FoundPath Dim names() As String For Each f As LeakObject In FoundPath names.Insert 0, f.ClassName Next System.DebugLog Join(names, " -> ") End If Next // cleanup Clear End Sub
Private Function FindLeaksIn(obj As LeakObject, FoundPath() As LeakObject) As Boolean obj.visited = True For Each ref As LeakObject In obj.references If ref.visited Then // found it FoundPath.Append ref Return True Else Dim found As Boolean = FindLeaksIn(ref, FoundPath) If found Then FoundPath.Append ref Return True End If End If Next End Function
Sub Process() Processed = True // clear references Dim objectsValues() As Variant = objects.values For Each o As LeakObject In objectsValues Redim o.references(-1) Next // find references For Each o As LeakObject In objectsValues Dim target As Variant = o.target // Handle a few special cases for classes #If TargetWeb Then If target IsA Webstyle Then Continue // ignore End If #ElseIf TargetDesktop If target IsA RectControl Then Dim r As RectControl = target If r.Handle = 0 Then // found leaked control! FoundLeak Array(o) Continue End If End If If target IsA Window Then // window checks controls Dim win As Window = target Dim c As Integer = win.ControlCount-1 For i As Integer = 0 To c Dim v As Variant = win.Control(i) o.AddReference Self, v Next Elseif target IsA Listbox Then // Tags of Listbox Dim list As Listbox = target Dim columnUbound As Integer = list.ColumnCount-1 For col As Integer = 0 To columnUbound Dim v As Variant = list.ColumnTag(col) o.AddReference Self, v Next #If XojoVersion >= 2020 Then Dim rowUbound As Integer = list.RowCount-1 #Else Dim rowUbound As Integer = list.ListCount-1 #EndIf For row As Integer = 0 To rowUbound Dim v As Variant = list.RowTag(row) o.AddReference Self, v For col As Integer = 0 To columnUbound v = list.CellTag(row, col) o.AddReference Self, v Next Next end if #EndIf #If XojoVersion >= 2020 Then If target IsA RowSet Then Dim r As RowSet = target Dim c As Integer = r.ColumnCount-1 For i As Integer = 0 To c Dim v As Variant = r.ColumnAt(i) o.AddReference Self, v Next end if #EndIf // dictionary If target IsA Dictionary Then Dim d As Dictionary = target For Each key As Variant In d.keys o.AddReference Self, key Dim value As Variant = d.Value(key) o.AddReference Self, value Next Elseif target IsA RecordSet Then Dim r As RecordSet = target Dim c As Integer = r.fieldcount For i As Integer = 1 To c // one-based Dim v As Variant = r.IdxField(i) o.AddReference Self, v Next End If // object arrays If target.Type = Variant.TypeArray + Variant.TypeObject Then Dim type As Introspection.TypeInfo = Introspection.GetType(target) If type <> Nil Then // internal objects will not have Introspection! If type.Name = "Object()" Then // array with one dimension Dim values() As Object = target For Each value As Variant In values o.AddReference Self, value Next Elseif type.Name = "Object(,)" Then // array with two dimensions Dim values(-1,-1) As Object = target Dim u1 As Integer = UBound(values, 1) Dim u2 As Integer = UBound(values, 2) For i1 As Integer = 0 To u1 For i2 As Integer = 0 To u2 Dim value As Variant = values(i1, i2) o.AddReference Self, value Next Next Elseif type.Name = "Object(,,)" Then // array with three dimensions Dim values(-1,-1,-1) As Object = target Dim u1 As Integer = UBound(values, 1) Dim u2 As Integer = UBound(values, 2) Dim u3 As Integer = UBound(values, 3) For i1 As Integer = 0 To u1 For i2 As Integer = 0 To u2 For i3 As Integer = 0 To u3 Dim value As Variant = values(i1, i2, i3) o.AddReference Self, value Next next Next Else Break // more dimensions? End If Else Break End If Continue End If // properties Dim type As Introspection.TypeInfo = Introspection.GetType(target) If type <> Nil Then // internal objects will not have Introspection! If type.name = "PropertyInfoImp" Then // private internal class Continue End If // handle non-weak delegates with AddressOf If type.name = "delegate" Then Dim weak As Boolean = GetDelegateWeakMBS(o.target) If Not weak Then Dim t As Variant = GetDelegateTargetMBS(o.target) If t <> Nil Then o.AddReference Self, t End If End If End If Dim properties() As Introspection.PropertyInfo = type.GetProperties #If TargetDesktop Then If target IsA RectControl Then // special handle for controls for the window property pointing to parent window, which is not a leak For Each PropertyInfo As Introspection.PropertyInfo In properties If PropertyInfo.Name = "window" Then // skip for controls Else #Pragma BreakOnExceptions False Try Dim value As Variant = PropertyInfo.Value(target) o.AddReference Self, value Catch r As RuntimeException // ignore exception End Try #Pragma BreakOnExceptions Default End If Next Continue End If #endif For Each PropertyInfo As Introspection.PropertyInfo In properties #Pragma BreakOnExceptions False Try Dim value As Variant = PropertyInfo.Value(target) #If TargetWeb // skip computed properties, which may show up often If o.target IsA WebFile And PropertyInfo.Name = "session" Then // ignore Continue Elseif o.target IsA WebPage And PropertyInfo.Name = "session" Then // ignore Continue Elseif o.target IsA WebControl And (PropertyInfo.Name = "page" Or PropertyInfo.Name = "parent") Then // ignore Continue end if #EndIf o.AddReference Self, value Catch r As RuntimeException // ignore exception End Try #Pragma BreakOnExceptions Default Next End If Next End Sub
Note "About"
Written 2020 by Christian Schmitz
Property Objects As Dictionary
Property Private Processed As Boolean
End Class
Class TestWindow Inherits Window
Control Label1 Inherits Label
ControlInstance Label1 Inherits Label
End Control
End Class
End Project

The items on this page are in the following plugins: MBS Main Plugin.


The biggest plugin in space...