├── .gitignore ├── .gitmodules ├── Delphinus.Info.json ├── Delphinus.Install.json ├── External ├── DUnit │ ├── FastMMMemLeakMonitor.pas │ ├── LICENSE.html │ └── TestFramework.pas └── DUnitX │ ├── DUnitX.MemoryLeakMonitor.LeakCheck.pas │ └── DUnitX.MemoryLeakMonitor.LeakCheckCycle.pas ├── License.txt ├── README.md ├── Samples ├── CustomLeakReport │ ├── .gitignore │ ├── LeakCheckCustomReport.dpr │ ├── LeakCheckCustomReport.dproj │ ├── LeakCheckCustomReport.res │ ├── TestMain.dfm │ └── TestMain.pas └── CustomLeakReportFMX │ ├── .gitignore │ ├── LeakCheckCustomReportFMX.deployproj │ ├── LeakCheckCustomReportFMX.dpr │ ├── LeakCheckCustomReportFMX.dproj │ ├── LeakCheckCustomReportFMX.res │ ├── TestMainFMX.fmx │ └── TestMainFMX.pas ├── Source ├── LeakCheck.Collections.pas ├── LeakCheck.Configuration.inc ├── LeakCheck.Cycle.Utils.pas ├── LeakCheck.Cycle.pas ├── LeakCheck.DUnit.pas ├── LeakCheck.DUnitCycle.pas ├── LeakCheck.MapFile.pas ├── LeakCheck.Report.FileLog.pas ├── LeakCheck.Report.Utils.pas ├── LeakCheck.Report.pas ├── LeakCheck.Setup.JclTrace.pas ├── LeakCheck.Setup.Trace.pas ├── LeakCheck.Trace.Backtrace.pas ├── LeakCheck.Trace.DbgHelp.pas ├── LeakCheck.Trace.Jcl.pas ├── LeakCheck.Trace.Map.pas ├── LeakCheck.Trace.WinApi.pas ├── LeakCheck.Trace.pas ├── LeakCheck.Types.inc ├── LeakCheck.Utils.pas ├── LeakCheck.inc └── LeakCheck.pas └── Test ├── .gitignore ├── LeakCheck.TestCycle.pas ├── LeakCheck.TestDUnit.pas ├── LeakCheck.TestDUnitX.pas ├── LeakCheck.TestForm.fmx ├── LeakCheck.TestForm.pas ├── LeakCheck.TestUnit.pas ├── XE ├── TestGroup.groupproj ├── TestProject.dpr ├── TestProject.dproj ├── TestProject.res ├── TestProjectX.dpr └── TestProjectX.dproj ├── XE6 ├── TestProject.deployproj ├── TestProject.dpr ├── TestProject.dproj └── TestProject.res ├── XE7 ├── TestGroup.groupproj ├── TestProject.deployproj ├── TestProject.dpr ├── TestProject.dproj ├── TestProject.res ├── TestProjectX.dpr ├── TestProjectX.dproj └── TestProjectX.res └── readme.txt /.gitignore: -------------------------------------------------------------------------------- 1 | __history/ 2 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "External/Backtrace"] 2 | path = External/Backtrace 3 | url = https://bitbucket.org/shadow_cs/delphi-arm-backtrace.git 4 | -------------------------------------------------------------------------------- /Delphinus.Info.json: -------------------------------------------------------------------------------- 1 | { 2 | "id": "{E2F44B06-C8AB-447A-A006-493E016A74CF}", 3 | "name": "LeakCheck", 4 | "license_type": "Apache 2.0", 5 | "license_file": "License.txt", 6 | "platforms": "Win32;Win64;OSX32", 7 | "compiler_min": 22, 8 | "dependencies": [{ 9 | "id": "{73E0C7A7-C9D6-4384-9AF5-117C574493AF}", 10 | "version_min": "0.0.2-Alpha" 11 | }] 12 | } 13 | -------------------------------------------------------------------------------- /Delphinus.Install.json: -------------------------------------------------------------------------------- 1 | { 2 | "search_pathes": [{ 3 | "pathes": "Source;External\\DUnit;External\\DUnitX", 4 | "platforms": "Win32;Win64;OSX32" 5 | } 6 | ], 7 | "source_folders": [{ 8 | "folder": ".", 9 | "filter": "License.txt" 10 | }, 11 | { 12 | "folder": "External", 13 | "recursive": true 14 | }, 15 | { 16 | "folder": "Samples", 17 | "recursive": true 18 | }, 19 | { 20 | "folder": "Source", 21 | "recursive": true 22 | }] 23 | } -------------------------------------------------------------------------------- /External/DUnit/FastMMMemLeakMonitor.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shadow-cs/delphi-leakcheck/67cc1bdfb670242b5b15d5942174c0024d7117b2/External/DUnit/FastMMMemLeakMonitor.pas -------------------------------------------------------------------------------- /External/DUnit/TestFramework.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shadow-cs/delphi-leakcheck/67cc1bdfb670242b5b15d5942174c0024d7117b2/External/DUnit/TestFramework.pas -------------------------------------------------------------------------------- /External/DUnitX/DUnitX.MemoryLeakMonitor.LeakCheck.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit DUnitX.MemoryLeakMonitor.LeakCheck; 26 | 27 | {$I DUnitX.inc} 28 | 29 | interface 30 | 31 | uses 32 | LeakCheck, 33 | Rtti, 34 | DUnitX.TestFramework; 35 | 36 | {$IF CompilerVersion >= 25} // >= XE4 37 | {$LEGACYIFEND ON} 38 | {$IFEND} 39 | 40 | type 41 | TDUnitXLeakCheckMemoryLeakMonitor = class(TInterfacedObject,IMemoryLeakMonitor 42 | {$IF Declared(IMemoryLeakMonitor2)} // Check if newer leak monitor is available 43 | ,IMemoryLeakMonitor2 44 | {$IFEND} 45 | ) 46 | private class var 47 | FRunnerLogMessages: TRttiField; 48 | class function GetRunnerLogMessages: TRttiField; 49 | private 50 | FPreSetUpSnapshot: TLeakCheck.TSnapshot; 51 | FPreTestSnapshot: TLeakCheck.TSnapshot; 52 | FPreTearDownSnapshot: TLeakCheck.TSnapshot; 53 | FSetUpAllocated: Int64; 54 | FTestAllocated: Int64; 55 | FTearDownAllocated: Int64; 56 | /// 57 | /// Set to true of there are any leaks detected anywhere in the test 58 | /// (SetUp/Test/TearDown). If false it indicates that all allocation 59 | /// functions should return zero. 60 | /// 61 | FTestLeaked: Boolean; 62 | FLeaksIgnored: Boolean; 63 | // Utility functions that are safe to use even in case of an exception 64 | // (not thread-safe) 65 | procedure BeginIgnore; 66 | procedure EndIgnore; 67 | function GetSnapshot: Pointer; 68 | strict protected 69 | property Snapshot: Pointer read GetSnapshot; 70 | public 71 | procedure AfterConstruction; override; 72 | destructor Destroy; override; 73 | 74 | procedure PreSetup; 75 | procedure PostSetUp; 76 | procedure PreTest; 77 | procedure PostTest; 78 | procedure PreTearDown; 79 | procedure PostTearDown; 80 | 81 | function SetUpMemoryAllocated: Int64; 82 | function TearDownMemoryAllocated: Int64; 83 | function TestMemoryAllocated: Int64; 84 | 85 | function GetReport: string; virtual; 86 | end; 87 | 88 | implementation 89 | 90 | uses 91 | LeakCheck.Utils, 92 | Classes, 93 | DUnitX.MemoryLeakMonitor.Default, 94 | DUnitX.IoC, 95 | DUnitX.TestRunner; 96 | 97 | {$REGION 'TDUnitXLeakCheckMemoryLeakMonitor'} 98 | 99 | // Basic idea is that all allocations made outside of the test object are 100 | // considered as not leaks. Since the leak monitor is short-lived and guaranteed 101 | // to free itself safely (since it is ref counted), we can safely disable leak 102 | // monitoring for short period of time. 103 | 104 | procedure TDUnitXLeakCheckMemoryLeakMonitor.AfterConstruction; 105 | begin 106 | inherited; 107 | FPreSetUpSnapshot.Create; 108 | BeginIgnore; 109 | end; 110 | 111 | procedure TDUnitXLeakCheckMemoryLeakMonitor.BeginIgnore; 112 | begin 113 | if not FLeaksIgnored then 114 | begin 115 | FLeaksIgnored := True; 116 | TLeakCheck.BeginIgnore; 117 | end; 118 | end; 119 | 120 | destructor TDUnitXLeakCheckMemoryLeakMonitor.Destroy; 121 | begin 122 | EndIgnore; 123 | inherited; 124 | end; 125 | 126 | procedure TDUnitXLeakCheckMemoryLeakMonitor.EndIgnore; 127 | begin 128 | if FLeaksIgnored then 129 | begin 130 | FLeaksIgnored := False; 131 | TLeakCheck.EndIgnore; 132 | end; 133 | end; 134 | 135 | function TDUnitXLeakCheckMemoryLeakMonitor.GetReport: string; 136 | var 137 | Report: LeakString; 138 | begin 139 | Report := TLeakCheck.GetReport(Snapshot); 140 | // Report is ASCII so it can be easily treated as UTF-8 141 | Result := sLineBreak + UTF8ToString(Report); 142 | Report.Free; 143 | end; 144 | 145 | class function TDUnitXLeakCheckMemoryLeakMonitor.GetRunnerLogMessages: TRttiField; 146 | 147 | procedure InitLogMessages; 148 | var 149 | Ctx: TRttiContext; 150 | begin 151 | Ctx := TRttiContext.Create; 152 | FRunnerLogMessages := Ctx.GetType(TDUnitXTestRunner).GetField('FLogMessages'); 153 | end; 154 | 155 | begin 156 | if not Assigned(FRunnerLogMessages) then 157 | InitLogMessages; 158 | Result := FRunnerLogMessages; 159 | end; 160 | 161 | function TDUnitXLeakCheckMemoryLeakMonitor.GetSnapshot: Pointer; 162 | begin 163 | Result := FPreSetUpSnapshot.Snapshot; 164 | end; 165 | 166 | procedure TDUnitXLeakCheckMemoryLeakMonitor.PostSetUp; 167 | begin 168 | FSetUpAllocated := FPreSetUpSnapshot.LeakSize; 169 | BeginIgnore; 170 | end; 171 | 172 | procedure TDUnitXLeakCheckMemoryLeakMonitor.PostTearDown; 173 | begin 174 | FTearDownAllocated := FPreTearDownSnapshot.LeakSize; 175 | BeginIgnore; 176 | end; 177 | 178 | procedure TDUnitXLeakCheckMemoryLeakMonitor.PostTest; 179 | begin 180 | FTestAllocated := FPreTestSnapshot.LeakSize; 181 | BeginIgnore; 182 | end; 183 | 184 | procedure TDUnitXLeakCheckMemoryLeakMonitor.PreSetup; 185 | begin 186 | System.Assert(Assigned(FPreSetUpSnapshot.Snapshot)); 187 | EndIgnore; 188 | end; 189 | 190 | procedure TDUnitXLeakCheckMemoryLeakMonitor.PreTearDown; 191 | begin 192 | FPreTearDownSnapshot.Create; 193 | EndIgnore; 194 | end; 195 | 196 | procedure TDUnitXLeakCheckMemoryLeakMonitor.PreTest; 197 | begin 198 | FPreTestSnapshot.Create; 199 | EndIgnore; 200 | end; 201 | 202 | function TDUnitXLeakCheckMemoryLeakMonitor.SetUpMemoryAllocated: Int64; 203 | var 204 | Runner: TObject; 205 | begin 206 | Runner := TDUnitX.CurrentRunner as TObject; 207 | if Runner is TDUnitXTestRunner then 208 | begin 209 | // Fixes issues that made DUnitX disable leak checking in commit 4d2f444. 210 | IgnoreStrings(GetRunnerLogMessages.GetValue(Runner).AsObject as TStrings); 211 | end; 212 | // Evaluate here as this is the first function guaranteed to run during leak 213 | // evaluation. 214 | FTestLeaked := FPreSetUpSnapshot.LeakSize > 0; 215 | {$IFOPT C+} 216 | if FTestLeaked then 217 | System.Assert(FSetUpAllocated + FTestAllocated + FTearDownAllocated > 0); 218 | // else summation may be not zero since we do not support negative leak size 219 | {$ENDIF} 220 | 221 | // If there are no leaks after teardown the test was OK 222 | if not FTestLeaked then 223 | Exit(0); 224 | 225 | Result := FSetUpAllocated; 226 | end; 227 | 228 | function TDUnitXLeakCheckMemoryLeakMonitor.TearDownMemoryAllocated: Int64; 229 | begin 230 | // If there are no leaks after teardown the test was OK 231 | if not FTestLeaked then 232 | Exit(0); 233 | 234 | Result := FTearDownAllocated; 235 | end; 236 | 237 | function TDUnitXLeakCheckMemoryLeakMonitor.TestMemoryAllocated: Int64; 238 | begin 239 | // If there are no leaks after teardown the test was OK 240 | if not FTestLeaked then 241 | Exit(0); 242 | 243 | Result := FTestAllocated; 244 | end; 245 | 246 | {$ENDREGION} 247 | 248 | procedure Inititalize; 249 | begin 250 | TDUnitXIoC.DefaultContainer.RegisterType( 251 | function : IMemoryLeakMonitor 252 | begin 253 | result := TDUnitXLeakCheckMemoryLeakMonitor.Create; 254 | end); 255 | end; 256 | 257 | initialization 258 | Inititalize; 259 | 260 | end. 261 | 262 | -------------------------------------------------------------------------------- /External/DUnitX/DUnitX.MemoryLeakMonitor.LeakCheckCycle.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit DUnitX.MemoryLeakMonitor.LeakCheckCycle; 26 | 27 | {$I DUnitX.inc} 28 | 29 | interface 30 | 31 | uses 32 | LeakCheck, 33 | SysUtils, 34 | TypInfo, 35 | LeakCheck.Cycle, 36 | DUnitX.MemoryLeakMonitor.LeakCheck; 37 | 38 | type 39 | /// 40 | /// In addition to detecting leaks, it also detect reference cycles in 41 | /// those leaks. Must be enabled manually. 42 | /// 43 | TDUnitXLeakCheckCycleMemoryLeakMonitor = class(TDUnitXLeakCheckMemoryLeakMonitor) 44 | strict private class var 45 | FUseExtendedRtti: Boolean; 46 | FOnInstanceIgnored: TScanner.TIsInstanceIgnored; 47 | strict protected 48 | FFormat: TCycle.TCycleFormats; 49 | ScanProc: function(const Instance: TObject; Flags: TScanFlags; 50 | InstanceIgnoreProc: TScanner.TIsInstanceIgnored): TCycles; 51 | procedure AppendCycles(var ErrorMsg: string; ASnapshot: Pointer); 52 | public 53 | procedure AfterConstruction; override; 54 | 55 | function GetReport: string; override; 56 | 57 | class property UseExtendedRtti: Boolean read FUseExtendedRtti write FUseExtendedRtti; 58 | class property OnInstanceIgnored: TScanner.TIsInstanceIgnored read FOnInstanceIgnored write FOnInstanceIgnored; 59 | end; 60 | 61 | /// 62 | /// Extends 63 | /// functionality by outputing Graphviz DOT compatible format that can be 64 | /// converted to graphical representation. 65 | /// 66 | TDUnitXLeakCheckCycleGraphMemoryLeakMonitor = class(TDUnitXLeakCheckCycleMemoryLeakMonitor) 67 | public 68 | procedure AfterConstruction; override; 69 | end; 70 | 71 | /// 72 | /// Extends 73 | /// functionality by outputing Graphviz DOT compatible format that can be 74 | /// converted to graphical representation. But instead of scanning just for 75 | /// cycles, it outputs the entire object structure tree. Warning: it can be 76 | /// a lot of data. 77 | /// 78 | TDUnitXLeakCheckGraphMemoryLeakMonitor = class(TDUnitXLeakCheckCycleMemoryLeakMonitor) 79 | public 80 | procedure AfterConstruction; override; 81 | end; 82 | 83 | implementation 84 | 85 | {$REGION 'TDUnitXLeakCheckCycleMemoryLeakMonitor'} 86 | 87 | procedure TDUnitXLeakCheckCycleMemoryLeakMonitor.AfterConstruction; 88 | begin 89 | inherited; 90 | ScanProc := ScanForCycles; 91 | // It is always useful but only supported with extended RTTI and not appended 92 | // otherwise. 93 | FFormat := [TCycleFormat.WithField]; 94 | end; 95 | 96 | procedure TDUnitXLeakCheckCycleMemoryLeakMonitor.AppendCycles( 97 | var ErrorMsg: string; ASnapshot: Pointer); 98 | var 99 | Leaks: TLeaks; 100 | Leak: TLeak; 101 | Cycles: TCycles; 102 | Flags: TScanFlags; 103 | Formatter: TCyclesFormatter; 104 | begin 105 | Formatter := TCyclesFormatter.Create(FFormat); 106 | // See LSnapshot in GetMemoryUseMsg 107 | TLeakCheck.MarkNotLeaking(ASnapshot); 108 | 109 | Flags := []; 110 | if UseExtendedRtti then 111 | Include(Flags, TScanFlag.UseExtendedRtti); 112 | 113 | Leaks := TLeakCheck.GetLeaks(Self.Snapshot); 114 | try 115 | for Leak in Leaks do 116 | if Leak.TypeKind = LeakCheck.tkClass then 117 | begin 118 | Cycles := ScanProc(Leak.Data, Flags, OnInstanceIgnored); 119 | Formatter.Append(Cycles); 120 | end; 121 | finally 122 | Leaks.Free; 123 | end; 124 | 125 | ErrorMsg := ErrorMsg + sLineBreak + Formatter.ToString; 126 | end; 127 | 128 | function TDUnitXLeakCheckCycleMemoryLeakMonitor.GetReport: string; 129 | var 130 | // Will mark any internal allocations of this functions as not a leak 131 | LSnapshot: TLeakCheck.TSnapshot; 132 | begin 133 | LSnapshot.Create; 134 | Result := inherited; 135 | AppendCycles(Result, LSnapshot.Snapshot); 136 | end; 137 | 138 | {$ENDREGION} 139 | 140 | {$REGION 'TDUnitXLeakCheckCycleGraphMemoryLeakMonitor'} 141 | 142 | procedure TDUnitXLeakCheckCycleGraphMemoryLeakMonitor.AfterConstruction; 143 | begin 144 | inherited; 145 | FFormat := [TCycleFormat.Graphviz, TCycleFormat.WithAddress, 146 | TCycleFormat.WithField, TCycleFormat.FindRoots]; 147 | end; 148 | 149 | {$ENDREGION} 150 | 151 | {$REGION 'TDUnitXLeakCheckGraphMemoryLeakMonitor'} 152 | 153 | procedure TDUnitXLeakCheckGraphMemoryLeakMonitor.AfterConstruction; 154 | begin 155 | inherited; 156 | FFormat := TCyclesFormatter.CompleteGraph; 157 | ScanProc := ScanGraph; 158 | end; 159 | 160 | {$ENDREGION} 161 | 162 | end. 163 | -------------------------------------------------------------------------------- /License.txt: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. 10 | 11 | "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. 12 | 13 | "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. 14 | 15 | "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. 16 | 17 | "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. 18 | 19 | "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. 20 | 21 | "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). 22 | 23 | "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. 24 | 25 | "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." 26 | 27 | "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 28 | 29 | 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 30 | 31 | 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 32 | 33 | 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: 34 | 35 | You must give any other recipients of the Work or Derivative Works a copy of this License; and 36 | 37 | You must cause any modified files to carry prominent notices stating that You changed the files; and 38 | 39 | You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and 40 | 41 | If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. 42 | You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 43 | 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 44 | 45 | 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 46 | 47 | 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 48 | 49 | 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 50 | 51 | 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. 52 | 53 | END OF TERMS AND CONDITIONS -------------------------------------------------------------------------------- /Samples/CustomLeakReport/.gitignore: -------------------------------------------------------------------------------- 1 | Win32/ 2 | Win64/ 3 | LeakCheckCustomReport.dproj.local 4 | LeakCheckCustomReport.identcache 5 | LeakCheckCustomReport.dsk 6 | -------------------------------------------------------------------------------- /Samples/CustomLeakReport/LeakCheckCustomReport.dpr: -------------------------------------------------------------------------------- 1 | program LeakCheckCustomReport; 2 | 3 | {$R *.res} 4 | 5 | uses 6 | // LeakCheck, // Does not need do be defined here (LeakCheck.Report will do it) unless you want to reference it from the DPR 7 | LeakCheck.Report, // Me first! - I don't have any dependencies but LeakCheck so I finalize after all other units 8 | LeakCheck.Setup.Trace, // (Optional) Then me - Run setup to configure stack tracing for us 9 | LeakCheck.Report.FileLog, // Then me - I'm the one that pulls some dependencies and have all the functionality 10 | Classes, // All other units 11 | Forms, 12 | StdCtrls, 13 | TestMain in 'TestMain.pas' {Form1}; 14 | 15 | begin 16 | Application.Initialize; 17 | Application.CreateForm(TForm1, Form1); 18 | Application.Run; 19 | end. 20 | -------------------------------------------------------------------------------- /Samples/CustomLeakReport/LeakCheckCustomReport.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shadow-cs/delphi-leakcheck/67cc1bdfb670242b5b15d5942174c0024d7117b2/Samples/CustomLeakReport/LeakCheckCustomReport.res -------------------------------------------------------------------------------- /Samples/CustomLeakReport/TestMain.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 337 6 | ClientWidth = 635 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object cmdAddLeak: TButton 17 | Left = 288 18 | Top = 176 19 | Width = 75 20 | Height = 25 21 | Caption = 'Add leak...' 22 | TabOrder = 0 23 | OnClick = cmdAddLeakClick 24 | end 25 | end 26 | -------------------------------------------------------------------------------- /Samples/CustomLeakReport/TestMain.pas: -------------------------------------------------------------------------------- 1 | unit TestMain; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls; 8 | 9 | type 10 | TForm1 = class(TForm) 11 | cmdAddLeak: TButton; 12 | procedure cmdAddLeakClick(Sender: TObject); 13 | private 14 | { Private declarations } 15 | public 16 | { Public declarations } 17 | end; 18 | 19 | var 20 | Form1: TForm1; 21 | 22 | implementation 23 | 24 | {$R *.dfm} 25 | 26 | procedure TForm1.cmdAddLeakClick(Sender: TObject); 27 | begin 28 | TButton.Create(nil); // Create a leak here 29 | end; 30 | 31 | end. 32 | -------------------------------------------------------------------------------- /Samples/CustomLeakReportFMX/.gitignore: -------------------------------------------------------------------------------- 1 | Win32/ 2 | Win64/ 3 | Android/ 4 | LeakCheckCustomReportFMX.dproj.local 5 | LeakCheckCustomReportFMX.identcache 6 | AndroidManifest.template.xml 7 | -------------------------------------------------------------------------------- /Samples/CustomLeakReportFMX/LeakCheckCustomReportFMX.deployproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 12 5 | 6 | 7 | 8 | LeakCheckCustomReportFMX\res\drawable-xlarge\ 9 | splash_image.png 10 | 1 11 | 12 | 13 | True 14 | 15 | 16 | LeakCheckCustomReportFMX\res\drawable-large\ 17 | splash_image.png 18 | 1 19 | 20 | 21 | True 22 | 23 | 24 | LeakCheckCustomReportFMX\library\lib\armeabi\ 25 | libLeakCheckCustomReportFMX.so 26 | 1 27 | 28 | 29 | True 30 | 31 | 32 | LeakCheckCustomReportFMX\res\drawable-xxhdpi\ 33 | ic_launcher.png 34 | 1 35 | 36 | 37 | True 38 | 39 | 40 | LeakCheckCustomReportFMX\res\drawable-mdpi\ 41 | ic_launcher.png 42 | 1 43 | 44 | 45 | True 46 | 47 | 48 | LeakCheckCustomReportFMX\res\drawable\ 49 | splash_image_def.xml 50 | 1 51 | 52 | 53 | True 54 | 55 | 56 | LeakCheckCustomReportFMX\library\lib\mips\ 57 | libLeakCheckCustomReportFMX.so 58 | 1 59 | 60 | 61 | True 62 | 63 | 64 | LeakCheckCustomReportFMX\ 65 | AndroidManifest.xml 66 | 1 67 | 68 | 69 | True 70 | 71 | 72 | LeakCheckCustomReportFMX\res\drawable-small\ 73 | splash_image.png 74 | 1 75 | 76 | 77 | True 78 | 79 | 80 | LeakCheckCustomReportFMX\classes\ 81 | classes.dex 82 | 1 83 | 84 | 85 | True 86 | 87 | 88 | LeakCheckCustomReportFMX\res\values\ 89 | styles.xml 90 | 1 91 | 92 | 93 | True 94 | 95 | 96 | LeakCheckCustomReportFMX\res\drawable-xhdpi\ 97 | ic_launcher.png 98 | 1 99 | 100 | 101 | True 102 | 103 | 104 | LeakCheckCustomReportFMX\library\lib\armeabi-v7a\ 105 | libLeakCheckCustomReportFMX.so 106 | 1 107 | 108 | 109 | True 110 | True 111 | 112 | 113 | LeakCheckCustomReportFMX\library\lib\armeabi-v7a\ 114 | gdbserver 115 | 1 116 | 117 | 118 | True 119 | 120 | 121 | LeakCheckCustomReportFMX\res\drawable-ldpi\ 122 | ic_launcher.png 123 | 1 124 | 125 | 126 | True 127 | 128 | 129 | LeakCheckCustomReportFMX\library\lib\x86\ 130 | libLeakCheckCustomReportFMX.so 131 | 1 132 | 133 | 134 | True 135 | 136 | 137 | LeakCheckCustomReportFMX\res\drawable-hdpi\ 138 | ic_launcher.png 139 | 1 140 | 141 | 142 | True 143 | 144 | 145 | LeakCheckCustomReportFMX\res\drawable-normal\ 146 | splash_image.png 147 | 1 148 | 149 | 150 | True 151 | 152 | 153 | 154 | 155 | 156 | LeakCheckCustomReportFMX\ 157 | LeakCheckCustomReportFMX.exe 158 | 0 159 | 160 | 161 | True 162 | True 163 | 164 | 165 | 166 | 167 | LeakCheckCustomReportFMX.app\Contents\MacOS\ 168 | libcgunwind.1.0.dylib 169 | 1 170 | 171 | 172 | True 173 | 174 | 175 | 176 | 177 | LeakCheckCustomReportFMX.app\ 178 | libcgunwind.1.0.dylib 179 | 1 180 | 181 | 182 | True 183 | 184 | 185 | 186 | 187 | -------------------------------------------------------------------------------- /Samples/CustomLeakReportFMX/LeakCheckCustomReportFMX.dpr: -------------------------------------------------------------------------------- 1 | program LeakCheckCustomReportFMX; 2 | 3 | uses 4 | // LeakCheck, // Does not need do be defined here (LeakCheck.Report will do it) unless you want to reference it from the DPR 5 | LeakCheck.Report, // Me first! - I don't have any dependencies but LeakCheck so I finalize after all other units 6 | LeakCheck.Setup.Trace, // (Optional) Then me - Run setup to configure stack tracing for us 7 | LeakCheck.Report.FileLog, // Then me - I'm the one that pulls some dependencies and have all the functionality 8 | System.StartUpCopy, // All other units 9 | FMX.Forms, 10 | TestMainFMX in 'TestMainFMX.pas' {Form2}; 11 | 12 | {$R *.res} 13 | 14 | begin 15 | Application.Initialize; 16 | Application.CreateForm(TForm2, Form2); 17 | Application.Run; 18 | end. 19 | -------------------------------------------------------------------------------- /Samples/CustomLeakReportFMX/LeakCheckCustomReportFMX.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shadow-cs/delphi-leakcheck/67cc1bdfb670242b5b15d5942174c0024d7117b2/Samples/CustomLeakReportFMX/LeakCheckCustomReportFMX.res -------------------------------------------------------------------------------- /Samples/CustomLeakReportFMX/TestMainFMX.fmx: -------------------------------------------------------------------------------- 1 | object Form2: TForm2 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form2' 5 | ClientHeight = 480 6 | ClientWidth = 640 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | DesignerMasterStyle = 0 11 | object cmdExit: TButton 12 | Position.X = 220.000000000000000000 13 | Position.Y = 244.000000000000000000 14 | Size.Width = 177.000000000000000000 15 | Size.Height = 85.000000000000000000 16 | Size.PlatformDefault = False 17 | TabOrder = 1 18 | Text = 'Exit' 19 | OnClick = cmdExitClick 20 | end 21 | object cmdAddLeak: TButton 22 | Position.X = 220.000000000000000000 23 | Position.Y = 104.000000000000000000 24 | Size.Width = 177.000000000000000000 25 | Size.Height = 85.000000000000000000 26 | Size.PlatformDefault = False 27 | TabOrder = 0 28 | Text = 'Add leak...' 29 | OnClick = cmdAddLeakClick 30 | end 31 | end 32 | -------------------------------------------------------------------------------- /Samples/CustomLeakReportFMX/TestMainFMX.pas: -------------------------------------------------------------------------------- 1 | unit TestMainFMX; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls; 8 | 9 | type 10 | TForm2 = class(TForm) 11 | cmdExit: TButton; 12 | cmdAddLeak: TButton; 13 | procedure cmdAddLeakClick(Sender: TObject); 14 | procedure cmdExitClick(Sender: TObject); 15 | private 16 | { Private declarations } 17 | public 18 | { Public declarations } 19 | end; 20 | 21 | var 22 | Form2: TForm2; 23 | 24 | implementation 25 | 26 | {$R *.fmx} 27 | 28 | procedure TForm2.cmdAddLeakClick(Sender: TObject); 29 | var 30 | o: TObject; 31 | begin 32 | Pointer(o) := TButton.Create(nil); 33 | end; 34 | 35 | procedure TForm2.cmdExitClick(Sender: TObject); 36 | begin 37 | Application.Terminate; 38 | end; 39 | 40 | end. 41 | -------------------------------------------------------------------------------- /Source/LeakCheck.Collections.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.Collections; 26 | 27 | {$I LeakCheck.inc} 28 | 29 | interface 30 | 31 | uses 32 | LeakCheck, 33 | {$IFDEF MSWINDOWS} 34 | Windows, 35 | {$ENDIF} 36 | Generics.Collections; 37 | 38 | type 39 | IDictionary = interface 40 | function TryGetValue(const Key: TKey; out Value: TValue): Boolean; 41 | procedure AddOrSetValue(const Key: TKey; const Value: TValue); 42 | function GetEnumerator: Generics.Collections.TDictionary.TPairEnumerator; 43 | end; 44 | 45 | TDictionary = class(Generics.Collections.TDictionary, 46 | IDictionary) 47 | protected 48 | {$IFNDEF AUTOREFCOUNT} 49 | FRefCount: Integer; 50 | {$ENDIF} 51 | function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; 52 | function _AddRef: Integer; stdcall; 53 | function _Release: Integer; stdcall; 54 | public 55 | {$IFNDEF AUTOREFCOUNT} 56 | procedure AfterConstruction; override; 57 | procedure BeforeDestruction; override; 58 | class function NewInstance: TObject; override; 59 | {$ENDIF} 60 | end; 61 | 62 | implementation 63 | 64 | { TDictionary } 65 | 66 | {$IFNDEF AUTOREFCOUNT} 67 | procedure TDictionary.AfterConstruction; 68 | begin 69 | inherited; 70 | // Release the constructor's implicit refcount 71 | {$IFNDEF MSWINDOWS} 72 | AtomicDecrement(FRefCount); 73 | {$ELSE MSWINDOWS} 74 | InterlockedDecrement(FRefCount); 75 | {$ENDIF MSWINDOWS} 76 | end; 77 | 78 | procedure TDictionary.BeforeDestruction; 79 | begin 80 | if FRefCount <> 0 then 81 | System.Error(reInvalidPtr); 82 | inherited; 83 | end; 84 | 85 | class function TDictionary.NewInstance: TObject; 86 | begin 87 | Result := inherited NewInstance; 88 | TDictionary(Result).FRefCount := 1; 89 | end; 90 | {$ENDIF} 91 | 92 | function TDictionary.QueryInterface(const IID: TGUID; 93 | out Obj): HResult; 94 | begin 95 | if GetInterface(IID, Obj) then 96 | Result := 0 97 | else 98 | Result := E_NOINTERFACE; 99 | end; 100 | 101 | function TDictionary._AddRef: Integer; 102 | begin 103 | {$IFNDEF AUTOREFCOUNT} 104 | {$IFNDEF MSWINDOWS} 105 | Result := AtomicIncrement(FRefCount); 106 | {$ELSE MSWINDOWS} 107 | Result := InterlockedIncrement(FRefCount); 108 | {$ENDIF MSWINDOWS} 109 | {$ELSE AUTOREFCOUNT} 110 | Result := __ObjAddRef; 111 | {$ENDIF AUTOREFCOUNT} 112 | end; 113 | 114 | function TDictionary._Release: Integer; 115 | begin 116 | {$IFNDEF AUTOREFCOUNT} 117 | {$IFNDEF MSWINDOWS} 118 | Result := AtomicDecrement(FRefCount); 119 | {$ELSE MSWINDOWS} 120 | Result := InterlockedDecrement(FRefCount); 121 | {$ENDIF MSWINDOWS} 122 | if Result = 0 then 123 | Destroy; 124 | {$ELSE AUTOREFCOUNT} 125 | Result := __ObjRelease; 126 | {$ENDIF AUTOREFCOUNT} 127 | end; 128 | 129 | end. 130 | -------------------------------------------------------------------------------- /Source/LeakCheck.Configuration.inc: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | const 26 | LeakCheckEnabled = {$IFNDEF LEAKCHECK_DISABLE}True{$ELSE}False{$ENDIF}; 27 | 28 | /// 29 | /// Maximum depth of stack traces. If greater than zero, stack trace will be 30 | /// acquired when memory is allocated. 31 | /// 32 | MaxStackSize = 64; 33 | 34 | /// 35 | /// Footer can be used to detect memory corruption and range errors. Enabled 36 | /// if greater than 0. (Size in multiples of pointer size) 37 | /// 38 | FooterSize = 0; 39 | 40 | /// 41 | /// Separator between internal LeakCheck data and the returned pointer. 42 | /// Can be used to detect memory corruption. Enabled if greater than 0. 43 | /// (Size in multiples of pointer size) 44 | /// 45 | SeparatorSize = 4; 46 | 47 | /// 48 | /// If enabled virtual calls on freed object will be intercepted and 49 | /// reported. 50 | /// 51 | EnableVirtualCallsOnFreedObjectInterception = True and LeakCheckEnabled; 52 | 53 | /// 54 | /// If enabled interface calls on freed object will be intercepted and 55 | /// reported. If not used together with VTablesFastFill significant 56 | /// slow-down will be exhibited. 57 | /// 58 | EnableInterfaceCallsOnFreedObjectInterception = False and LeakCheckEnabled; 59 | 60 | /// 61 | /// Since checking for class type is pretty slow, enabling this option will 62 | /// use just a faster move but will clear all memory not just objects. 63 | /// 64 | EnableInterfaceVTablesFastFill = True and 65 | EnableInterfaceCallsOnFreedObjectInterception; 66 | 67 | /// 68 | /// If enabled fake VMT is assigned to freed objects so other utilities do 69 | /// not raise AVs if they reach dangling pointer of a freed object (if they 70 | /// do freed object checking). If freed object virtual call interception is 71 | /// not enabled. Virtual call on this pointer will raise NPE. 72 | /// 73 | EnableFreedObjectDetection = (True or 74 | EnableVirtualCallsOnFreedObjectInterception or 75 | EnableInterfaceCallsOnFreedObjectInterception) and LeakCheckEnabled; 76 | 77 | // Used internally 78 | EnableFreeCleanup = EnableFreedObjectDetection or (SeparatorSize > 0) or 79 | (FooterSize > 0); 80 | 81 | // Used internally 82 | NeedsIndexTypes = 83 | EnableVirtualCallsOnFreedObjectInterception or 84 | EnableInterfaceCallsOnFreedObjectInterception; 85 | 86 | /// 87 | /// If enabled (together with MaxStackSize) stack trace is acquired 88 | /// also when memory is released. 89 | /// 90 | RecordFreeStackTrace = False or 91 | EnableVirtualCallsOnFreedObjectInterception or 92 | EnableInterfaceCallsOnFreedObjectInterception; 93 | 94 | /// 95 | /// Use separate heap for internal allocations, disable if you leak count 96 | /// is getting bigger and the internal functions fail to function. 97 | /// Enabling this option will ensure that freed memory of current process 98 | /// will not be overwritten by LeakCheck internal data. 99 | /// (MS Windows only) 100 | /// 101 | UseInternalHeap = True; 102 | 103 | {$IF Declared(TScanner)} 104 | type 105 | /// 106 | /// Type of sanitation to be done. 107 | /// 108 | TScannerSanitationType = ( 109 | /// 110 | /// No sanitation at all. 111 | /// 112 | None, 113 | /// 114 | /// Check for TLeckCheck.TFreedObject, but do not perform more 115 | /// complex tests (faster). 116 | /// 117 | FreedObject, 118 | /// 119 | /// The scanner will put object through series of tests to determine 120 | /// whether the given pointer is valid and some basic class fields are 121 | /// readable (About 10x slower, See LeakCheck.GetObjectClass). 122 | /// 123 | Complex); 124 | 125 | const 126 | /// 127 | /// Enable sanitation of object pointers in a scanner. 128 | /// 129 | ScannerEnableObjectPointerSanitation = 130 | {$IF EnableFreedObjectDetection} 131 | TScannerSanitationType.FreedObject 132 | {$ELSE} 133 | TScannerSanitationType.Complex 134 | {$IFEND} 135 | ; 136 | {$IFEND} 137 | -------------------------------------------------------------------------------- /Source/LeakCheck.Cycle.Utils.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.Cycle.Utils; 26 | 27 | {$I LeakCheck.inc} 28 | 29 | interface 30 | 31 | uses 32 | LeakCheck, 33 | LeakCheck.Trace, 34 | LeakCheck.Utils, 35 | LeakCheck.Cycle; 36 | 37 | type 38 | TGraphIgnorer = class(TScanner) 39 | strict protected 40 | { Do not use TypeStart! Since AFieldName is sometimes passed here if 41 | inspecting first class field and then class instance, false positives may 42 | be reached which would lead to errors and always use more specific 43 | functions. } 44 | procedure ScanClassInternal(const Instance: TObject); override; 45 | end; 46 | 47 | /// 48 | /// Ignore all leaks in object graph given by entry-point. Note that all 49 | /// object inside the graph have to have all object fields with valid 50 | /// references. If invalid reference is kept in any of the fields and is 51 | /// freed without nil-ing the field, AV will probably be raised. May also 52 | /// cause issues if used in multi-threaded environment (that have 53 | /// race-condition issues). 54 | /// 55 | procedure IgnoreGraphLeaks(const Entrypoint: TObject; Flags: TScanFlags = []; 56 | InstanceIgnoreProc: TScanner.TIsInstanceIgnored = nil); 57 | 58 | type 59 | TIgnore = class(LeakCheck.Utils.TIgnore) 60 | public 61 | /// 62 | /// Ignore the class and all fields from it and all objects within its 63 | /// object graph (all nested object that are referenced from this 64 | /// object). May easily ignore large portions of your memory. Use with 65 | /// care. 66 | /// 67 | class function AnyAndGraph(const Instance: TObject; ClassType: TClass): Boolean; static; 68 | end; 69 | 70 | TIgnoreInterface = class(LeakCheck.Utils.TIgnoreInterface) 71 | public 72 | /// 73 | /// Ignore the implementing class and all fields from it and all objects 74 | /// within itsobject graph (all nested object that are referenced from 75 | /// this object). May easily ignore large portions of your memory. Use 76 | /// with care. 77 | /// 78 | class function ImplementsAndGraph(const Instance: TObject; ClassType: TClass): Boolean; static; 79 | end; 80 | 81 | implementation 82 | 83 | procedure IgnoreGraphLeaks(const Entrypoint: TObject; Flags: TScanFlags = []; 84 | InstanceIgnoreProc: TScanner.TIsInstanceIgnored = nil); 85 | begin 86 | TGraphIgnorer.Scan(Entrypoint, TGraphIgnorer, Flags, InstanceIgnoreProc); 87 | end; 88 | 89 | {$REGION 'TGraphIgnorer'} 90 | 91 | procedure TGraphIgnorer.ScanClassInternal(const Instance: TObject); 92 | begin 93 | inherited; 94 | if Assigned(Instance) then 95 | begin 96 | {$IFDEF LEAKCHECK_TRACE} 97 | Trace('Ignoring: ' + Instance.QualifiedClassName); 98 | {$ENDIF} 99 | RegisterExpectedMemoryLeak(Instance); 100 | end; 101 | end; 102 | 103 | {$ENDREGION} 104 | 105 | {$REGION 'TIgnore'} 106 | 107 | class function TIgnore.AnyAndGraph(const Instance: TObject; 108 | ClassType: TClass): Boolean; 109 | begin 110 | Result := ClassType.InheritsFrom(T); 111 | if Result then 112 | IgnoreGraphLeaks(Instance, [TScanFlag.UseExtendedRtti]); 113 | end; 114 | 115 | {$ENDREGION} 116 | 117 | {$REGION 'TIgnoreInterface'} 118 | 119 | class function TIgnoreInterface.ImplementsAndGraph(const Instance: TObject; 120 | ClassType: TClass): Boolean; 121 | begin 122 | Result := Implements(Instance, ClassType); 123 | if Result then 124 | IgnoreGraphLeaks(Instance, [TScanFlag.UseExtendedRtti]); 125 | end; 126 | 127 | {$ENDREGION} 128 | 129 | end. 130 | -------------------------------------------------------------------------------- /Source/LeakCheck.DUnit.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.DUnit; 26 | 27 | {$I LeakCheck.inc} 28 | 29 | interface 30 | 31 | uses 32 | LeakCheck, 33 | SysUtils, 34 | TestFramework; 35 | 36 | type 37 | TLeakCheckMonitor = class(TInterfacedObject, IMemLeakMonitor, IDUnitMemLeakMonitor) 38 | private 39 | FSnapshot: TLeakCheck.TSnapshot; 40 | function LeakDetail(ASnapshot: Pointer): string; 41 | function GetSnapshot: Pointer; 42 | strict protected 43 | property Snapshot: Pointer read GetSnapshot; 44 | public 45 | procedure AfterConstruction; override; 46 | 47 | // IMemLeakMonitor 48 | function MemLeakDetected(out LeakSize: Integer): Boolean; overload; 49 | 50 | // IDUnitMemLeakMonitor 51 | function MemLeakDetected(const AllowedLeakSize: Integer; 52 | const FailOnMemoryRecovery: Boolean; 53 | out LeakSize: Integer): Boolean; overload; 54 | function MemLeakDetected(const AllowedValuesGetter: TListIterator; 55 | const FailOnMemoryRecovery: Boolean; 56 | out LeakIndex: integer; 57 | out LeakSize: Integer): Boolean; overload; 58 | function GetMemoryUseMsg(const FailOnMemoryRecovery: Boolean; 59 | const TestProcChangedMem: Integer; 60 | out ErrorMsg: string): Boolean; overload; 61 | function GetMemoryUseMsg(const FailOnMemoryRecovery: boolean; 62 | const TestSetupChangedMem: Integer; 63 | const TestProcChangedMem: Integer; 64 | const TestTearDownChangedMem: Integer; 65 | const TestCaseChangedMem: Integer; 66 | out ErrorMsg: string): boolean; overload; 67 | procedure MarkMemInUse; 68 | procedure TestMethodDone(const Test: ITest); 69 | end; 70 | 71 | implementation 72 | 73 | uses 74 | LeakCheck.Utils; 75 | 76 | { TLeakCheckMonitor } 77 | 78 | function TLeakCheckMonitor.GetMemoryUseMsg(const FailOnMemoryRecovery: Boolean; 79 | const TestProcChangedMem: Integer; out ErrorMsg: string): Boolean; 80 | var 81 | // Will mark any internal allocations of this functions as not a leak 82 | LSnapshot: TLeakCheck.TSnapshot; 83 | begin 84 | ErrorMsg := ''; 85 | LSnapshot.Create; 86 | 87 | if TestProcChangedMem > 0 then 88 | ErrorMsg := IntToStr(TestProcChangedMem) + 89 | ' Bytes Memory Leak in Test Procedure' + LeakDetail(LSnapshot.Snapshot) 90 | else 91 | if (TestProcChangedMem < 0) and (FailOnMemoryRecovery) then 92 | ErrorMsg := IntToStr(Abs(TestProcChangedMem)) + 93 | ' Bytes Memory Recovered in Test Procedure' + LeakDetail(LSnapshot.Snapshot); 94 | 95 | Result := Length(ErrorMsg) = 0; 96 | end; 97 | 98 | procedure TLeakCheckMonitor.AfterConstruction; 99 | begin 100 | inherited; 101 | MarkMemInUse; 102 | end; 103 | 104 | function TLeakCheckMonitor.LeakDetail(ASnapshot: Pointer): string; 105 | var 106 | Report: LeakString; 107 | begin 108 | // See LSnapshot in GetMemoryUseMsg 109 | TLeakCheck.MarkNotLeaking(ASnapshot); 110 | Report := TLeakCheck.GetReport(Snapshot); 111 | // Report is ASCII so it can be easily treated as UTF-8 112 | Result := sLineBreak + UTF8ToString(Report); 113 | Report.Free; 114 | end; 115 | 116 | function TLeakCheckMonitor.GetMemoryUseMsg(const FailOnMemoryRecovery: boolean; 117 | const TestSetupChangedMem, TestProcChangedMem, TestTearDownChangedMem, 118 | TestCaseChangedMem: Integer; out ErrorMsg: string): boolean; 119 | var 120 | // Will mark any internal allocations of this functions as not a leak 121 | LSnapshot: TLeakCheck.TSnapshot; 122 | Location: string; 123 | begin 124 | Result := False; 125 | ErrorMsg := ''; 126 | LSnapshot.Create; 127 | 128 | if (TestSetupChangedMem = 0) and (TestProcChangedMem = 0) and 129 | (TestTearDownChangedMem = 0) and (TestCaseChangedMem <> 0) then 130 | begin 131 | ErrorMsg := 132 | 'Test leaked memory. No leaks in Setup, TestProc or Teardown but '+ 133 | IntToStr(TestCaseChangedMem) + 134 | ' Bytes Memory Leak reported across TestCase' + LeakDetail(LSnapshot.Snapshot); 135 | Exit; 136 | end; 137 | 138 | if (TestSetupChangedMem + TestProcChangedMem + TestTearDownChangedMem) <> 139 | TestCaseChangedMem then 140 | begin 141 | ErrorMsg := 142 | 'Test leaked memory. Sum of Setup, TestProc and Teardown leaks <> '+ 143 | IntToStr(TestCaseChangedMem) + 144 | ' Bytes Memory Leak reported across TestCase' + LeakDetail(LSnapshot.Snapshot); 145 | Exit; 146 | end; 147 | 148 | Result := True; 149 | if TestCaseChangedMem = 0 then 150 | Exit; // Don't waste further time here 151 | 152 | if (TestCaseChangedMem < 0) and not FailOnMemoryRecovery then 153 | Exit; // Don't waste further time here 154 | 155 | 156 | // We get to here because there is a memory use imbalance to report. 157 | if (TestCaseChangedMem > 0) then 158 | ErrorMsg := IntToStr(TestCaseChangedMem) + ' Bytes memory leak (' 159 | else 160 | ErrorMsg := IntToStr(TestCaseChangedMem) + ' Bytes memory recovered ('; 161 | 162 | Location := ''; 163 | 164 | if (TestSetupChangedMem <> 0) then 165 | Location := 'Setup= ' + IntToStr(TestSetupChangedMem) + ' '; 166 | if (TestProcChangedMem <> 0) then 167 | Location := Location + 'TestProc= ' + IntToStr(TestProcChangedMem) + ' '; 168 | if (TestTearDownChangedMem <> 0) then 169 | Location := Location + 'TearDown= ' + IntToStr(TestTearDownChangedMem) + ' '; 170 | 171 | ErrorMsg := ErrorMsg + Location + ')' + LeakDetail(LSnapshot.Snapshot); 172 | Result := (Length(ErrorMsg) = 0); 173 | end; 174 | 175 | function TLeakCheckMonitor.GetSnapshot: Pointer; 176 | begin 177 | Result := FSnapshot.Snapshot; 178 | end; 179 | 180 | procedure TLeakCheckMonitor.MarkMemInUse; 181 | begin 182 | FSnapshot.Create; 183 | end; 184 | 185 | function TLeakCheckMonitor.MemLeakDetected(out LeakSize: Integer): Boolean; 186 | var 187 | Leaks: TLeaks; 188 | begin 189 | Leaks := TLeakCheck.GetLeaks(Snapshot); 190 | Result := Leaks.Length > 0; 191 | LeakSize := Leaks.TotalSize; 192 | Leaks.Free; 193 | end; 194 | 195 | function TLeakCheckMonitor.MemLeakDetected(const AllowedLeakSize: Integer; 196 | const FailOnMemoryRecovery: Boolean; out LeakSize: Integer): Boolean; 197 | begin 198 | LeakSize := 0; 199 | MemLeakDetected(LeakSize); 200 | Result := ((LeakSize > 0) and (LeakSize <> AllowedLeakSize)) or 201 | ((LeakSize < 0) and (FailOnMemoryRecovery) and (LeakSize <> AllowedLeakSize)); 202 | end; 203 | 204 | function TLeakCheckMonitor.MemLeakDetected( 205 | const AllowedValuesGetter: TListIterator; const FailOnMemoryRecovery: Boolean; 206 | out LeakIndex, LeakSize: Integer): Boolean; 207 | var 208 | AllowedLeakSize: Integer; 209 | begin 210 | LeakIndex := 0; 211 | LeakSize := 0; 212 | Result := False; 213 | MemLeakDetected(LeakSize); 214 | 215 | if LeakSize = 0 then 216 | Exit; 217 | 218 | // Next line access value stored via SetAllowedLeakSize, if any 219 | if LeakSize = AllowedValuesGetter then 220 | Exit; 221 | 222 | // Loop over values stored via SetAllowedLeakArray 223 | repeat 224 | Inc(LeakIndex); 225 | AllowedLeakSize := AllowedValuesGetter; 226 | if (LeakSize = AllowedLeakSize) then 227 | Exit; 228 | until AllowedLeakSize = 0; 229 | 230 | Result := (LeakSize > 0) or ((LeakSize < 0) and FailOnMemoryRecovery); 231 | end; 232 | 233 | type 234 | TAbstractTestAccess = class(TAbstractTest); 235 | 236 | procedure TLeakCheckMonitor.TestMethodDone(const Test: ITest); 237 | var 238 | AbstractTest: TAbstractTestAccess; 239 | begin 240 | if Test is TAbstractTest then 241 | begin 242 | AbstractTest := TAbstractTestAccess(Test as TObject); 243 | if Assigned(AbstractTest.FStatusStrings) then 244 | IgnoreStrings(AbstractTest.FStatusStrings); 245 | end; 246 | end; 247 | 248 | initialization 249 | TestFramework.MemLeakMonitorClass := TLeakCheckMonitor; 250 | 251 | end. 252 | -------------------------------------------------------------------------------- /Source/LeakCheck.DUnitCycle.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.DUnitCycle; 26 | 27 | {$I LeakCheck.inc} 28 | 29 | interface 30 | 31 | uses 32 | LeakCheck, 33 | SysUtils, 34 | TypInfo, 35 | TestFramework, 36 | LeakCheck.Cycle, 37 | LeakCheck.DUnit; 38 | 39 | type 40 | /// 41 | /// In addition to detecting leaks, it also detect reference cycles in 42 | /// those leaks. Must be enabled manually. 43 | /// 44 | TLeakCheckCycleMonitor = class(TLeakCheckMonitor, IDUnitMemLeakMonitor) 45 | strict private class var 46 | FUseExtendedRtti: Boolean; 47 | FOnInstanceIgnored: TScanner.TIsInstanceIgnored; 48 | strict protected 49 | FFormat: TCycle.TCycleFormats; 50 | ScanProc: function(const Instance: TObject; Flags: TScanFlags; 51 | InstanceIgnoreProc: TScanner.TIsInstanceIgnored): TCycles; 52 | procedure AppendCycles(var ErrorMsg: string; ASnapshot: Pointer); 53 | public 54 | procedure AfterConstruction; override; 55 | function GetMemoryUseMsg(const FailOnMemoryRecovery: Boolean; 56 | const TestProcChangedMem: Integer; 57 | out ErrorMsg: string): Boolean; overload; 58 | function GetMemoryUseMsg(const FailOnMemoryRecovery: boolean; 59 | const TestSetupChangedMem: Integer; 60 | const TestProcChangedMem: Integer; 61 | const TestTearDownChangedMem: Integer; 62 | const TestCaseChangedMem: Integer; 63 | out ErrorMsg: string): boolean; overload; 64 | class property UseExtendedRtti: Boolean read FUseExtendedRtti write FUseExtendedRtti; 65 | class property OnInstanceIgnored: TScanner.TIsInstanceIgnored read FOnInstanceIgnored write FOnInstanceIgnored; 66 | end; 67 | 68 | /// 69 | /// Extends 70 | /// functionality by outputing Graphviz DOT compatible format that can be 71 | /// converted to graphical representation. 72 | /// 73 | TLeakCheckCycleGraphMonitor = class(TLeakCheckCycleMonitor) 74 | public 75 | procedure AfterConstruction; override; 76 | end; 77 | 78 | /// 79 | /// Extends 80 | /// functionality by outputing Graphviz DOT compatible format that can be 81 | /// converted to graphical representation. But instead of scanning just for 82 | /// cycles, it outputs the entire object structure tree. Warning: it can be 83 | /// a lot of data. 84 | /// 85 | TLeakCheckGraphMonitor = class(TLeakCheckCycleMonitor) 86 | public 87 | procedure AfterConstruction; override; 88 | end; 89 | 90 | implementation 91 | 92 | {$REGION 'TLeakCheckCycleMonitor'} 93 | 94 | function TLeakCheckCycleMonitor.GetMemoryUseMsg( 95 | const FailOnMemoryRecovery: Boolean; const TestProcChangedMem: Integer; 96 | out ErrorMsg: string): Boolean; 97 | var 98 | // Will mark any internal allocations of this functions as not a leak 99 | LSnapshot: TLeakCheck.TSnapshot; 100 | begin 101 | LSnapshot.Create; 102 | Result := inherited; 103 | if not Result then 104 | AppendCycles(ErrorMsg, LSnapshot.Snapshot); 105 | end; 106 | 107 | procedure TLeakCheckCycleMonitor.AfterConstruction; 108 | begin 109 | inherited; 110 | ScanProc := ScanForCycles; 111 | // It is always useful but only supported with extended RTTI and not appended 112 | // otherwise. 113 | FFormat := [TCycleFormat.WithField]; 114 | end; 115 | 116 | procedure TLeakCheckCycleMonitor.AppendCycles(var ErrorMsg: string; ASnapshot: Pointer); 117 | var 118 | Leaks: TLeaks; 119 | Leak: TLeak; 120 | Cycles: TCycles; 121 | Flags: TScanFlags; 122 | Formatter: TCyclesFormatter; 123 | begin 124 | Formatter := TCyclesFormatter.Create(FFormat); 125 | // See LSnapshot in GetMemoryUseMsg 126 | TLeakCheck.MarkNotLeaking(ASnapshot); 127 | 128 | Flags := []; 129 | if UseExtendedRtti then 130 | Include(Flags, TScanFlag.UseExtendedRtti); 131 | 132 | Leaks := TLeakCheck.GetLeaks(Self.Snapshot); 133 | try 134 | for Leak in Leaks do 135 | if Leak.TypeKind = LeakCheck.tkClass then 136 | begin 137 | Cycles := ScanProc(Leak.Data, Flags, OnInstanceIgnored); 138 | Formatter.Append(Cycles); 139 | end; 140 | finally 141 | Leaks.Free; 142 | end; 143 | 144 | ErrorMsg := ErrorMsg + sLineBreak + Formatter.ToString; 145 | end; 146 | 147 | function TLeakCheckCycleMonitor.GetMemoryUseMsg( 148 | const FailOnMemoryRecovery: boolean; const TestSetupChangedMem, 149 | TestProcChangedMem, TestTearDownChangedMem, TestCaseChangedMem: Integer; 150 | out ErrorMsg: string): boolean; 151 | var 152 | // Will mark any internal allocations of this functions as not a leak 153 | LSnapshot: TLeakCheck.TSnapshot; 154 | begin 155 | LSnapshot.Create; 156 | Result := inherited; 157 | if not Result then 158 | AppendCycles(ErrorMsg, LSnapshot.Snapshot); 159 | end; 160 | 161 | {$ENDREGION} 162 | 163 | {$REGION 'TLeakCheckCycleGraphMonitor'} 164 | 165 | procedure TLeakCheckCycleGraphMonitor.AfterConstruction; 166 | begin 167 | inherited; 168 | FFormat := [TCycleFormat.Graphviz, TCycleFormat.WithAddress, 169 | TCycleFormat.WithField, TCycleFormat.FindRoots]; 170 | end; 171 | 172 | {$ENDREGION} 173 | 174 | {$REGION 'TLeakCheckGraphMonitor'} 175 | 176 | procedure TLeakCheckGraphMonitor.AfterConstruction; 177 | begin 178 | inherited; 179 | FFormat := TCyclesFormatter.CompleteGraph; 180 | ScanProc := ScanGraph; 181 | end; 182 | 183 | {$ENDREGION} 184 | 185 | end. 186 | -------------------------------------------------------------------------------- /Source/LeakCheck.Report.FileLog.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.Report.FileLog; 26 | 27 | {$I LeakCheck.inc} 28 | 29 | interface 30 | 31 | uses 32 | LeakCheck, 33 | LeakCheck.Report.Utils; 34 | 35 | implementation 36 | 37 | {$IF CompilerVersion >= 25} // >= XE4 38 | {$LEGACYIFEND ON} 39 | {$IFEND} 40 | 41 | uses 42 | {$IFDEF MSWINDOWS} 43 | Windows, 44 | {$ENDIF} 45 | {$IFDEF POSIX} 46 | Posix.Unistd, 47 | {$ENDIF} 48 | {$IFDEF ANDROID} 49 | Androidapi.Log, 50 | {$ENDIF} 51 | IOUtils, 52 | SysUtils; 53 | 54 | type 55 | TLeakCheckFileReporter = class(TLeakCheckReporter) 56 | private 57 | FLogFileName: string; 58 | FGraphFileName: string; 59 | FLog: TextFile; 60 | protected 61 | constructor Create; override; 62 | procedure NoLeaks; override; 63 | procedure BeginLog; override; 64 | procedure WritelnLog(Log: MarshaledAString); override; 65 | procedure EndLog; override; 66 | procedure WriteGraph(const Graph: string); override; 67 | procedure ShowMessage; override; 68 | end; 69 | 70 | { TLeakCheckFileReporter } 71 | 72 | procedure TLeakCheckFileReporter.BeginLog; 73 | begin 74 | inherited; 75 | AssignFile(FLog, FLogFileName); 76 | Rewrite(FLog); 77 | end; 78 | 79 | constructor TLeakCheckFileReporter.Create; 80 | var 81 | BasePath, BaseName: string; 82 | begin 83 | inherited; 84 | 85 | {$IF Defined(MACOS) OR Defined(IOS) OR Defined(LEAK_REPORT_DOCUMENTS)} 86 | BasePath := TPath.GetDocumentsPath; 87 | BaseName := ExtractFileName(ParamStr(0)); 88 | {$ELSEIF Defined(MSWINDOWS)} 89 | BasePath := ExtractFilePath(ParamStr(0)); 90 | BaseName := ExtractFileName(ParamStr(0)); 91 | {$ELSEIF Defined(ANDROID)} 92 | // Note that this requires Read/Write External Storage permissions 93 | // Write permissions option is enough, reading will be available as well 94 | BasePath := '/storage/emulated/0/'; 95 | BaseName := 'LeakCheck_Log'; 96 | {$IFEND} 97 | BasePath := TPath.Combine(BasePath, ChangeFileExt(BaseName, '')); 98 | 99 | FLogFileName := BasePath + '.log'; 100 | FGraphFileName := BasePath + '.dot'; 101 | end; 102 | 103 | procedure TLeakCheckFileReporter.EndLog; 104 | begin 105 | inherited; 106 | CloseFile(FLog); 107 | end; 108 | 109 | procedure TLeakCheckFileReporter.NoLeaks; 110 | begin 111 | inherited; 112 | DeleteFile(FLogFileName); 113 | DeleteFile(FGraphFileName); 114 | end; 115 | 116 | procedure TLeakCheckFileReporter.ShowMessage; 117 | {$IFDEF ANDROID} 118 | const 119 | TAG: MarshaledAString = MarshaledAString('leak'); 120 | var 121 | M: TMarshaller; 122 | {$ENDIF} 123 | var 124 | Msg: string; 125 | begin 126 | inherited; 127 | Msg := 'Memory leak detected, see ' + FLogFileName + ' and ' + FGraphFileName; 128 | {$IFDEF MSWINDOWS} 129 | MessageBox(0, PChar(Msg), 'Memory leak', MB_ICONERROR); 130 | {$ENDIF} 131 | {$IFDEF ANDROID} 132 | __android_log_write(ANDROID_LOG_WARN, TAG, M.AsAnsi(Msg).ToPointer); 133 | {$ENDIF} 134 | end; 135 | 136 | procedure TLeakCheckFileReporter.WriteGraph(const Graph: string); 137 | var 138 | f: TextFile; 139 | begin 140 | inherited; 141 | AssignFile(f, FGraphFileName); 142 | Rewrite(f); 143 | try 144 | Writeln(f, Graph); 145 | finally 146 | CloseFile(f); 147 | end; 148 | end; 149 | 150 | procedure TLeakCheckFileReporter.WritelnLog(Log: MarshaledAString); 151 | begin 152 | inherited; 153 | Writeln(FLog, Log); 154 | end; 155 | 156 | initialization 157 | ReporterClass := TLeakCheckFileReporter; 158 | 159 | end. 160 | -------------------------------------------------------------------------------- /Source/LeakCheck.Report.Utils.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.Report.Utils; 26 | 27 | {$I LeakCheck.inc} 28 | 29 | interface 30 | 31 | uses 32 | LeakCheck; 33 | 34 | type 35 | TReportFormat = (WithLog, WithCycles); 36 | TReportFormats = set of TReportFormat; 37 | 38 | TLeakCheckReporter = class 39 | protected 40 | procedure NoLeaks; virtual; 41 | procedure BeginLog; virtual; 42 | procedure WritelnLog(Log: MarshaledAString); virtual; 43 | procedure EndLog; virtual; 44 | procedure WriteGraph(const Graph: string); virtual; 45 | procedure ShowMessage; virtual; 46 | constructor Create; virtual; 47 | end; 48 | TLeakCheckReporterClass = class of TLeakCheckReporter; 49 | 50 | var 51 | ReportFormat: TReportFormats = [TReportFormat.WithLog, TReportFormat.WithCycles]; 52 | ReporterClass: TLeakCheckReporterClass = TLeakCheckReporter; 53 | 54 | implementation 55 | 56 | uses 57 | LeakCheck.Report, 58 | LeakCheck.Cycle, 59 | SysUtils, 60 | TypInfo; 61 | 62 | var 63 | Reporter: TLeakCheckReporter; 64 | 65 | 66 | procedure ReportProc(const Data: MarshaledAString); 67 | begin 68 | Reporter.WritelnLog(Data); 69 | end; 70 | 71 | /// 72 | /// Will generate memory report and dangling object graph to help you 73 | /// understand what causes the leak. Works regardless of 74 | /// ReportMemoryLeaksOnShutdown. 75 | /// 76 | procedure SaveReport(const Snapshot: TLeakCheck.TSnapshot); 77 | var 78 | Formatter: TCyclesFormatter; 79 | Leaks: TLeaks; 80 | Leak: TLeak; 81 | Cycles: TCycles; 82 | InternalSnapshot: TLeakCheck.TSnapshot; 83 | begin 84 | if ReportFormat = [] then 85 | Exit; 86 | 87 | InternalSnapshot.Create; 88 | Reporter := ReporterClass.Create; 89 | // Make sure we do not report memory we just allocated 90 | TLeakCheck.MarkNotLeaking(InternalSnapshot.Snapshot); 91 | // Internal LeakCheck reporting functions use different memory manager so 92 | // they won't show up in the report so we don't need to ignore them again 93 | // (Windows uses completely separate memory manager where other platforms just 94 | // skip LeakCheck allocation mechanisms and defer that to the system memory 95 | // manager directly). 96 | Leaks := TLeakCheck.GetLeaks(Snapshot.Snapshot); 97 | try 98 | if Leaks.IsEmpty then 99 | begin 100 | Reporter.NoLeaks; 101 | Exit; 102 | end; 103 | 104 | {$IFDEF WEAKREF} 105 | // Do not report unknown pointers if WeakRefs are used, it is most likely 106 | // held by System WeakRef pool (RTL bug). 107 | TLeakCheck.IgnoredLeakTypes := [tkUnknown]; 108 | {$ENDIF} 109 | 110 | // Save the log 111 | if TReportFormat.WithLog in ReportFormat then 112 | begin 113 | Reporter.BeginLog; 114 | try 115 | TLeakCheck.GetReport(ReportProc, Snapshot.Snapshot); 116 | finally 117 | Reporter.EndLog; 118 | end; 119 | end; 120 | 121 | // Save the graph 122 | if TReportFormat.WithCycles in ReportFormat then 123 | begin 124 | Formatter := TCyclesFormatter.Create([ 125 | TCycleFormat.Graphviz, 126 | TCycleFormat.WithAddress, 127 | TCycleFormat.WithField]); 128 | for Leak in Leaks do 129 | if Leak.TypeKind = LeakCheck.tkClass then 130 | begin 131 | Cycles := ScanGraph(Leak.Data, [TScanFlag.UseExtendedRtti]); 132 | Formatter.Append(Cycles); 133 | end; 134 | Reporter.WriteGraph(Formatter.ToString); 135 | end; 136 | 137 | Reporter.ShowMessage; 138 | 139 | ReportMemoryLeaksOnShutdown := False; 140 | finally 141 | Leaks.Free; 142 | Reporter.Free; 143 | end; 144 | end; 145 | 146 | { TLeakCheckReport } 147 | 148 | procedure TLeakCheckReporter.BeginLog; 149 | begin 150 | // NOP 151 | end; 152 | 153 | constructor TLeakCheckReporter.Create; 154 | begin 155 | inherited; 156 | end; 157 | 158 | procedure TLeakCheckReporter.EndLog; 159 | begin 160 | // NOP 161 | end; 162 | 163 | procedure TLeakCheckReporter.NoLeaks; 164 | begin 165 | // NOP 166 | end; 167 | 168 | procedure TLeakCheckReporter.ShowMessage; 169 | begin 170 | // NOP 171 | end; 172 | 173 | procedure TLeakCheckReporter.WriteGraph(const Graph: string); 174 | begin 175 | // NOP 176 | end; 177 | 178 | procedure TLeakCheckReporter.WritelnLog(Log: MarshaledAString); 179 | begin 180 | // NOP 181 | end; 182 | 183 | initialization 184 | GetReport := SaveReport; 185 | 186 | end. 187 | -------------------------------------------------------------------------------- /Source/LeakCheck.Report.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.Report; 26 | 27 | interface 28 | 29 | {$I LeakCheck.inc} 30 | 31 | uses 32 | LeakCheck; 33 | 34 | var 35 | /// 36 | /// Some other unit must set this callback. It will be called just before 37 | /// LeakCheck finalizes but unlike this unit, it may use some higher level 38 | /// functionality. This hacks the way how unit initialization and 39 | /// finalization works so use with care. 40 | /// 41 | GetReport: procedure(const Snapshot: TLeakCheck.TSnapshot); 42 | 43 | implementation 44 | 45 | var 46 | Snapshot: TLeakCheck.TSnapshot; 47 | 48 | initialization 49 | // Create a Snapshot to hide some accidental allocations made by internal 50 | // units. 51 | Snapshot.Create; 52 | 53 | finalization 54 | // Run high level stuff from other unit after all other units have finalized 55 | // (dangerous if you don't know what you're doing). 56 | if Assigned(GetReport) then 57 | GetReport(Snapshot); 58 | end. 59 | -------------------------------------------------------------------------------- /Source/LeakCheck.Setup.JclTrace.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | /// 26 | /// Unit that if placed as first unit in the project will initialize 27 | /// LeakCheck memory manager together with the JCL raw stack tracer and trace 28 | /// formatter. This configuration has JCL external dependency. 29 | /// 30 | unit LeakCheck.Setup.JclTrace; 31 | 32 | {$I LeakCheck.inc} 33 | 34 | interface 35 | 36 | uses 37 | LeakCheck, 38 | LeakCheck.Utils; 39 | 40 | implementation 41 | 42 | uses 43 | LeakCheck.Trace.Jcl; 44 | 45 | initialization 46 | {$IFDEF CPUX64} 47 | TLeakCheck.GetStackTraceProc := JclFramesStackTrace; 48 | {$ELSE} 49 | TLeakCheck.GetStackTraceProc := JclRawStackTrace; 50 | {$ENDIF} 51 | TLeakCheck.GetStackTraceFormatterProc := JclStackTraceFormatter; 52 | 53 | end. 54 | -------------------------------------------------------------------------------- /Source/LeakCheck.Setup.Trace.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | /// 26 | /// Unit that if placed as first unit in the project will initialize 27 | /// LeakCheck memory manager together with the WinApi stack tracer and MAP 28 | /// file based trace formatter on Windows or Backtrace and Posix.Proc trace 29 | /// formatter on Posix. This configuration has no external dependencies. 30 | /// 31 | unit LeakCheck.Setup.Trace; 32 | 33 | {$I LeakCheck.inc} 34 | 35 | interface 36 | 37 | uses 38 | LeakCheck, 39 | LeakCheck.Utils; 40 | 41 | implementation 42 | 43 | {$IFDEF MSWINDOWS} 44 | uses 45 | LeakCheck.Trace.WinApi, 46 | LeakCheck.Trace.Map; 47 | 48 | initialization 49 | TLeakCheck.GetStackTraceProc := WinApiStackTrace; 50 | TLeakCheck.GetStackTraceFormatterProc := MapStackTraceFormatter; 51 | {$ENDIF} 52 | 53 | {$IFDEF POSIX} 54 | uses 55 | LeakCheck.Trace.Backtrace; 56 | 57 | initialization 58 | TLeakCheck.GetStackTraceProc := BacktraceStackTrace; 59 | TLeakCheck.GetStackTraceFormatterProc := PosixProcStackTraceFormatter; 60 | {$ENDIF} 61 | 62 | end. 63 | -------------------------------------------------------------------------------- /Source/LeakCheck.Trace.Backtrace.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.Trace.Backtrace; 26 | 27 | {$I LeakCheck.inc} 28 | 29 | interface 30 | 31 | uses 32 | LeakCheck, 33 | Posix.Backtrace, 34 | Posix.Proc; 35 | 36 | /// 37 | /// Currently the only POSIX (Android) implementation, does not support frame 38 | /// skipping. 39 | /// 40 | function BacktraceStackTrace(IgnoredFrames: Integer; Data: PPointer; 41 | Size: Integer): Integer; 42 | 43 | /// 44 | /// Formats stack trace addresses so they can be fed to addr2line 45 | /// utility. 46 | /// 47 | function PosixProcStackTraceFormatter: TLeakCheck.IStackTraceFormatter; 48 | 49 | implementation 50 | 51 | uses 52 | System.SysUtils, 53 | System.Math; 54 | 55 | function BacktraceStackTrace(IgnoredFrames: Integer; Data: PPointer; 56 | Size: Integer): Integer; 57 | begin 58 | Result := backtrace(Data, Size); 59 | end; 60 | 61 | type 62 | TPosixProcStackTraceFormatter = class(TInterfacedObject, TLeakCheck.IStackTraceFormatter) 63 | private 64 | FProcEntries: TPosixProcEntryList; 65 | public 66 | constructor Create; 67 | destructor Destroy; override; 68 | 69 | function FormatLine(Addr: Pointer; const Buffer: MarshaledAString; 70 | Size: Integer): Integer; 71 | end; 72 | 73 | { TPosixProcStackTraceFormatter } 74 | 75 | constructor TPosixProcStackTraceFormatter.Create; 76 | begin 77 | inherited Create; 78 | FProcEntries := TPosixProcEntryList.Create; 79 | FProcEntries.LoadFromCurrentProcess; 80 | end; 81 | 82 | destructor TPosixProcStackTraceFormatter.Destroy; 83 | begin 84 | FProcEntries.Free; 85 | inherited; 86 | end; 87 | 88 | function TPosixProcStackTraceFormatter.FormatLine(Addr: Pointer; 89 | const Buffer: MarshaledAString; Size: Integer): Integer; 90 | var 91 | s: string; 92 | M: TMarshaller; 93 | P: MarshaledAString; 94 | begin 95 | TLeakCheck.BeginIgnore; 96 | try 97 | s := FProcEntries.GetStackLine(NativeUInt(Addr)); 98 | Result := Min(Length(s), Size - 1); 99 | if Result > 0 then 100 | begin 101 | P:=M.AsAnsi(s).ToPointer; 102 | Move(P^, Buffer^, Result + 1); // Add trailing zero 103 | end; 104 | finally 105 | TLeakCheck.EndIgnore; 106 | end; 107 | end; 108 | 109 | function PosixProcStackTraceFormatter: TLeakCheck.IStackTraceFormatter; 110 | begin 111 | Result := TPosixProcStackTraceFormatter.Create; 112 | end; 113 | 114 | end. 115 | -------------------------------------------------------------------------------- /Source/LeakCheck.Trace.DbgHelp.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.Trace.DbgHelp; 26 | 27 | {$I LeakCheck.inc} 28 | 29 | interface 30 | 31 | /// 32 | /// Native DbgHelp solution. Win 32 only. Similar to WinApi solution but 33 | /// works without Win32 support if DbgHelp redistributable is installed. Does 34 | /// not use global caches. 35 | /// 36 | function DbgHelpStackTrace(IgnoredFrames: Integer; Data: PPointer; 37 | Size: Integer): Integer; 38 | 39 | implementation 40 | 41 | uses 42 | Windows; 43 | 44 | {$ALIGN 4} 45 | 46 | type 47 | PKDHELP = ^KDHELP; 48 | KDHELP = record 49 | // 50 | // address of kernel thread object, as provided in the 51 | // WAIT_STATE_CHANGE packet. 52 | // 53 | Thread: DWORD; 54 | // 55 | // offset in thread object to pointer to the current callback frame 56 | // in kernel stack. 57 | // 58 | ThCallbackStack: DWORD; 59 | // 60 | // offsets to values in frame: 61 | // 62 | // address of next callback frame 63 | NextCallback: DWORD; 64 | // address of saved frame pointer (if applicable) 65 | FramePointer: DWORD; 66 | // 67 | // Address of the kernel function that calls out to user mode 68 | // 69 | KiCallUserMode: DWORD; 70 | // 71 | // Address of the user mode dispatcher function 72 | // 73 | KeUserCallbackDispatcher: DWORD; 74 | // 75 | // Lowest kernel mode address 76 | // 77 | SystemRangeStart: DWORD; 78 | // 79 | // offset in thread object to pointer to the current callback backing 80 | // store frame in kernel stack. 81 | // 82 | ThCallbackBStore: DWORD; 83 | Reserved: array[0..7] of DWORD; 84 | end; 85 | type 86 | ADDRESS_MODE = (AddrMode1616, AddrMode1632, AddrModeReal, AddrModeFlat); 87 | 88 | LPADDRESS = ^ADDRESS; 89 | ADDRESS = record 90 | Offset: DWORD; 91 | Segment: WORD; 92 | Mode: DWORD; 93 | end; 94 | 95 | LPSTACKFRAME = ^STACKFRAME; 96 | STACKFRAME = record 97 | AddrPC: ADDRESS; // program counter 98 | AddrReturn: ADDRESS; // return address 99 | AddrFrame: ADDRESS; // frame pointer 100 | AddrStack: ADDRESS; // stack pointer 101 | FuncTableEntry: Pointer; // pointer to pdata/fpo or NULL 102 | Params: array[0..3] of DWORD; // possible arguments to the function 103 | bFar: LONGBOOL; // WOW far call 104 | bVirtual: LONGBOOL; // is this a virtual frame? 105 | Reserved: array[0..2] of DWORD; 106 | KdHelp: KDHELP; 107 | AddrBStore: ADDRESS; // backing store pointer 108 | end; 109 | 110 | PIMAGEHLP_LINE = ^IMAGEHLP_LINE; 111 | IMAGEHLP_LINE = record 112 | SizeOfStruct: DWORD; // set to sizeof(IMAGEHLP_LINE) 113 | Key: Pointer; // internal 114 | LineNumber: DWORD; // line number in file 115 | FileName: PChar; // full filename 116 | Address: DWORD; // first instruction of line 117 | end; 118 | 119 | PREAD_PROCESS_MEMORY_ROUTINE = function(hProcess: THandle; lpBaseAddress: DWORD; 120 | lpBuffer: Pointer; nSize: DWORD; var lpNumberOfBytesRead: DWORD): Boolean; stdcall; 121 | 122 | PFUNCTION_TABLE_ACCESS_ROUTINE = function(hProcess: THandle; AddrBase: DWORD): Pointer; stdcall; 123 | 124 | PGET_MODULE_BASE_ROUTINE = function(hProcess: THandle; Address: DWORD): DWORD; stdcall; 125 | 126 | PTRANSLATE_ADDRESS_ROUTINE = function(hProcess, hThread: THandle; lpaddr: LPADDRESS): DWORD; stdcall; 127 | 128 | const 129 | SDbgHelpDll = 'dbghelp.dll'; 130 | 131 | function StackWalk(MachineType: DWORD; hProcess, hThread: THandle; 132 | StackFrame: LPSTACKFRAME; ContextRecord: Pointer; 133 | ReadMemoryRoutine: PREAD_PROCESS_MEMORY_ROUTINE; 134 | FunctionTableAccessRoutine: PFUNCTION_TABLE_ACCESS_ROUTINE; 135 | GetModuleBaseRoutine: PGET_MODULE_BASE_ROUTINE; 136 | TranslateAddress: PTRANSLATE_ADDRESS_ROUTINE): Integer; stdcall; external SDbgHelpDll; 137 | function SymFunctionTableAccess(hProcess: THandle; AddrBase: DWORD): Pointer; stdcall; external SDbgHelpDll; 138 | function SymGetModuleBase(hProcess: THandle; Address: DWORD): DWORD; stdcall; external SDbgHelpDll; 139 | 140 | function GetEIP : DWORD; assembler; 141 | asm 142 | mov EAX, dword ptr [ESP] 143 | end; 144 | 145 | function GetESP : DWORD; assembler; 146 | asm 147 | mov EAX, ESP 148 | end; 149 | 150 | function GetEBP : DWORD; assembler; 151 | asm 152 | mov EAX, EBP 153 | end; 154 | 155 | procedure InitContext(var Context: TContext); 156 | begin 157 | FillChar(Context, sizeof(TContext), 0); 158 | Context.ContextFlags := CONTEXT_FULL; 159 | 160 | Context.Eip:=GetEIP; 161 | Context.Esp:=GetESP+4; 162 | Context.Ebp:=GetEBP; 163 | end; 164 | 165 | procedure Prepare(var Stack: STACKFRAME; const Context: TContext); 166 | begin 167 | FillChar(Stack, sizeof(STACKFRAME), 0); 168 | Stack.AddrPC.Offset := Context.Eip; 169 | Stack.AddrPC.Mode := DWORD(AddrModeFlat); 170 | Stack.AddrStack.Offset := Context.Esp; 171 | Stack.AddrStack.Mode := DWORD(AddrModeFlat); 172 | Stack.AddrFrame.Offset := Context.Ebp; 173 | Stack.AddrFrame.Mode := DWORD(AddrModeFlat); 174 | end; 175 | 176 | function GetNextFrame(var Stack: STACKFRAME; var Context: TContext): Pointer; 177 | begin 178 | if (StackWalk(IMAGE_FILE_MACHINE_I386, GetCurrentProcess(), GetCurrentThread(), 179 | @Stack, @Context, nil, SymFunctionTableAccess, SymGetModuleBase, nil) <> 0) then 180 | begin 181 | Result := Pointer(Stack.AddrPC.Offset); 182 | end 183 | else 184 | Result := nil; 185 | end; 186 | 187 | function DbgHelpStackTrace(IgnoredFrames: Integer; Data: PPointer; 188 | Size: Integer): Integer; 189 | var 190 | Context: TContext; 191 | Stack: STACKFRAME; 192 | i: Integer; 193 | Addr: Pointer; 194 | begin 195 | InitContext(Context); 196 | Prepare(Stack, Context); 197 | Result := 0; 198 | 199 | // First skip ignored frames 200 | for i := 0 to IgnoredFrames - 1 do 201 | begin 202 | Addr := GetNextFrame(Stack, Context); 203 | if not Assigned(Addr) then 204 | Exit; 205 | end; 206 | 207 | // Then record the trace 208 | for i := 0 to Size - 1 do 209 | begin 210 | Addr := GetNextFrame(Stack, Context); 211 | if not Assigned(Addr) then 212 | Exit; 213 | Inc(Result); 214 | Data^ := Addr; 215 | Inc(Data); 216 | end; 217 | end; 218 | 219 | end. 220 | -------------------------------------------------------------------------------- /Source/LeakCheck.Trace.Jcl.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.Trace.Jcl; 26 | 27 | {$I LeakCheck.inc} 28 | 29 | interface 30 | 31 | {$I jcl.inc} 32 | 33 | uses 34 | LeakCheck, JclDebug; 35 | 36 | /// 37 | /// JCL solution performing frame-based scanning. Win 32 and Win 64 only. 38 | /// Reasonably safe and robust Win 32 implementation, identical to 39 | /// LeakCheck.Trace.WinApi on Win64. Uses global caches! 40 | /// 41 | function JclFramesStackTrace(IgnoredFrames: Integer; Data: PPointer; 42 | Size: Integer): Integer; 43 | {$IFDEF CPU32} 44 | /// 45 | /// JCL solution performing raw scanning (matches entire stack while scanning 46 | /// all valid addresses, may produce invalid calls but is also able to 47 | /// display more information than other techniques). Win 32 and Win 64 only. 48 | /// Identical to LeakCheck.Trace.WinApi on Win64. Uses global caches! 49 | /// 50 | function JclRawStackTrace(IgnoredFrames: Integer; Data: PPointer; 51 | Size: Integer): Integer; 52 | {$ENDIF} 53 | 54 | /// 55 | /// JCL implementation using different methods to obtain the formatted line 56 | /// (including debug symbols and MAP file). Uses global caches! 57 | /// 58 | function JclStackTraceFormatter: TLeakCheck.IStackTraceFormatter; 59 | 60 | implementation 61 | 62 | uses 63 | Math; 64 | 65 | function JclStackTrace(IgnoredFrames: Integer; Data: PPointer; 66 | Size: Integer; Raw: Boolean): Integer; 67 | var 68 | OldTracer: TLeakCheck.TGetStackTrace; 69 | StackList: TJclStackInfoList; 70 | i: Integer; 71 | begin 72 | // There are some allocations in the JCL tracer that would cause a cycle so 73 | // suspend allocation tracing during stack tracing. Also ignore JCL global 74 | // caches. 75 | OldTracer := TLeakCheck.GetStackTraceProc; 76 | TLeakCheck.GetStackTraceProc := nil; 77 | TLeakCheck.BeginIgnore; 78 | try 79 | // Use TJclStackInfoList directly (without calling JclCreateStackList) to 80 | // bypass JCL caches. 81 | StackList := TJclStackInfoList.Create(Raw, IgnoredFrames, nil); 82 | try 83 | Result := Min(StackList.Count, Size); 84 | for i := 0 to Result - 1 do 85 | begin 86 | Data^ := StackList[i].CallerAddr; 87 | Inc(Data); 88 | end; 89 | finally 90 | StackList.Free; 91 | end; 92 | finally 93 | TLeakCheck.EndIgnore; 94 | TLeakCheck.GetStackTraceProc := OldTracer; 95 | end; 96 | end; 97 | 98 | function JclFramesStackTrace(IgnoredFrames: Integer; Data: PPointer; 99 | Size: Integer): Integer; 100 | begin 101 | Result := JclStackTrace(IgnoredFrames + 3, Data, Size, False); 102 | end; 103 | 104 | {$IFDEF CPU32} 105 | function JclRawStackTrace(IgnoredFrames: Integer; Data: PPointer; 106 | Size: Integer): Integer; 107 | begin 108 | Result := JclStackTrace(IgnoredFrames + 5, Data, Size, True); 109 | end; 110 | {$ENDIF} 111 | 112 | type 113 | TJclStackTraceFormatter = class(TInterfacedObject, TLeakCheck.IStackTraceFormatter) 114 | public 115 | function FormatLine(Addr: Pointer; const Buffer: MarshaledAString; 116 | Size: Integer): Integer; 117 | end; 118 | 119 | { TJclStackTraceFormatter } 120 | 121 | function TJclStackTraceFormatter.FormatLine(Addr: Pointer; 122 | const Buffer: MarshaledAString; Size: Integer): Integer; 123 | var 124 | s: AnsiString; 125 | begin 126 | TLeakCheck.BeginIgnore; 127 | try 128 | s := AnsiString(GetLocationInfoStr(Addr, True, True, True, True)); 129 | Result := Min(Length(s), Size - 1); 130 | if Result > 0 then 131 | Move(s[1], Buffer^, Result + 1); // Add trailing zero 132 | finally 133 | TLeakCheck.EndIgnore; 134 | end; 135 | end; 136 | 137 | function JclStackTraceFormatter: TLeakCheck.IStackTraceFormatter; 138 | var 139 | s: string; 140 | begin 141 | // Get some info to initialize global cache 142 | s := GetLocationInfoStr( 143 | {$IF (CompilerVersion >= 23.0)}ReturnAddress{$ELSE}Caller(0, True){$IFEND}, 144 | True, True, True, True); 145 | s := ''; 146 | Result := TJclStackTraceFormatter.Create; 147 | end; 148 | 149 | initialization 150 | finalization 151 | // JCL global caches are about to be cleared, no further tracing is possible 152 | if (Pointer(TLeakCheck.GetStackTraceProc) = @JclFramesStackTrace) 153 | {$IF SizeOf(Pointer) = 4} 154 | or (Pointer(TLeakCheck.GetStackTraceProc) = @JclRawStackTrace) 155 | {$IFEND} 156 | then 157 | begin 158 | TLeakCheck.GetStackTraceProc := nil; 159 | end; 160 | if Pointer(TLeakCheck.GetStackTraceFormatterProc) = @JclStackTraceFormatter then 161 | TLeakCheck.CleanupStackTraceFormatter; 162 | end. 163 | -------------------------------------------------------------------------------- /Source/LeakCheck.Trace.Map.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.Trace.Map; 26 | 27 | {$I LeakCheck.inc} 28 | 29 | interface 30 | 31 | uses 32 | LeakCheck, 33 | LeakCheck.MapFile; 34 | 35 | /// 36 | /// Based on own implementation that does not use global caching and is safe 37 | /// to use after finalization. Supports function names and line numbers with 38 | /// displacement. Does not have any external dependencies. 39 | /// 40 | function MapStackTraceFormatter: TLeakCheck.IStackTraceFormatter; 41 | 42 | implementation 43 | 44 | uses 45 | SysUtils, 46 | Generics.Collections, 47 | Math, 48 | AnsiStrings, 49 | Windows; 50 | 51 | type 52 | TMapStackTraceFormatter = class(TInterfacedObject, TLeakCheck.IStackTraceFormatter) 53 | private type 54 | TMAPCache = TObjectDictionary; 55 | private 56 | FMaps: TMAPCache; 57 | function GetSymobls(Addr: Pointer; var ModuleName: string): TMAPCollection; 58 | public 59 | constructor Create; 60 | destructor Destroy; override; 61 | 62 | function FormatLine(Addr: Pointer; const Buffer: MarshaledAString; 63 | Size: Integer): Integer; 64 | end; 65 | 66 | { TMapStackTraceFormatter } 67 | 68 | constructor TMapStackTraceFormatter.Create; 69 | begin 70 | inherited Create; 71 | FMaps := TMAPCache.Create([doOwnsValues]); 72 | end; 73 | 74 | destructor TMapStackTraceFormatter.Destroy; 75 | begin 76 | FMaps.Free; 77 | inherited; 78 | end; 79 | 80 | function TMapStackTraceFormatter.FormatLine(Addr: Pointer; 81 | const Buffer: MarshaledAString; Size: Integer): Integer; 82 | var 83 | OldTracer: TLeakCheck.TGetStackTrace; 84 | ModuleName: string; 85 | s: string; 86 | ansi: AnsiString; 87 | Map: TMAPCollection; 88 | Displacement: NativeUInt; 89 | i, j: Integer; 90 | begin 91 | OldTracer := TLeakCheck.GetStackTraceProc; 92 | TLeakCheck.GetStackTraceProc := nil; 93 | TLeakCheck.BeginIgnore; 94 | try 95 | Map := GetSymobls(Addr, ModuleName); 96 | s := '$' + IntToHex(NativeUInt(Addr), SizeOf(Pointer) * 2) + ' - ' + 97 | ExtractFileName(ModuleName); 98 | if Assigned(Map) then 99 | begin 100 | // Format line 101 | s:=s + ' - ' + Map.GetNearestSymbol(NativeUInt(Addr), Displacement); 102 | s:=s + ' + $' + IntToHex(Displacement, 0); 103 | if (Map.HasLines and (Displacement < $40000)) then 104 | begin 105 | // Get the beginning line of the function 106 | i := Map.GetNearestLine(NativeUInt(Addr) - Displacement, Displacement); 107 | // Should be 0 but in case we don't have debug DCUs ot there 108 | // are no symbols for this particular unit, it will be bigger 109 | if (Displacement <= $2000) then 110 | begin 111 | j := Map.GetNearestLine(NativeUInt(Addr), Displacement); 112 | s := s + ' (' +IntToStr(j); 113 | if (Displacement <> 0) then 114 | s := s + ' + $' + IntToHex(Displacement, 0); 115 | s := s + ' +' + IntToStr(j - i) + ')'; 116 | end; 117 | end; 118 | // else most likely way off code 119 | end; 120 | 121 | Result := Min(Length(s), Size - 1); 122 | if Result > 0 then 123 | begin 124 | ansi := AnsiString(s); 125 | Move(ansi[1], Buffer^, Result + 1); // Add trailing zero 126 | end; 127 | finally 128 | TLeakCheck.EndIgnore; 129 | TLeakCheck.GetStackTraceProc := OldTracer; 130 | end; 131 | end; 132 | 133 | function TMapStackTraceFormatter.GetSymobls(Addr: Pointer; 134 | var ModuleName: string): TMAPCollection; 135 | var 136 | MapName: string; 137 | mbi: MEMORY_BASIC_INFORMATION; 138 | begin 139 | VirtualQuery(Addr, mbi, sizeof(mbi)); 140 | SetLength(ModuleName, MAX_PATH+1); 141 | SetLength(ModuleName, GetModuleFileName(Cardinal(mbi.AllocationBase), 142 | PChar(ModuleName), MAX_PATH)); 143 | if not FMaps.TryGetValue(ModuleName, Result) then 144 | begin 145 | MapName := ChangeFileExt(ModuleName, '.map'); 146 | if (FileExists(MapName)) then begin 147 | Result:=TMAPCollection.Create; 148 | try 149 | Result.CodeBase:=NativeUInt(mbi.AllocationBase); 150 | Result.LoadFromFile(MapName); 151 | except 152 | Result.Free; 153 | raise; 154 | end; 155 | end 156 | else 157 | Result := nil; 158 | FMaps.Add(ModuleName, Result); 159 | end; 160 | end; 161 | 162 | function MapStackTraceFormatter: TLeakCheck.IStackTraceFormatter; 163 | begin 164 | Result := TMapStackTraceFormatter.Create; 165 | end; 166 | 167 | end. 168 | -------------------------------------------------------------------------------- /Source/LeakCheck.Trace.WinApi.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.Trace.WinApi; 26 | 27 | {$I LeakCheck.inc} 28 | 29 | interface 30 | 31 | /// 32 | /// Native Windows API solution. Performs basic scanning and may omit some 33 | /// stack frames. Win32 and Win64 only. Best solution for Win64. Does not use 34 | /// global caches. 35 | /// 36 | function WinApiStackTrace(IgnoredFrames: Integer; Data: PPointer; 37 | Size: Integer): Integer; 38 | 39 | implementation 40 | 41 | uses 42 | Windows, 43 | SysUtils; 44 | 45 | function RtlCaptureStackBackTrace(FramesToSkip: ULONG; FramesToCapture: ULONG; 46 | BackTrace: PPointer; BackTraceHash : PULONG = nil): USHORT; 47 | stdcall; external 'kernel32.dll'; 48 | 49 | var 50 | // Current windows version is XP or older (RtlCaptureStackBackTrace is not 51 | // suppored on older version than XP according to MSDN, it may be supported 52 | // on Windows 2000 but the documentation has been stripped off already) 53 | WinXPDown: Boolean = False; 54 | 55 | function WinApiStackTrace(IgnoredFrames: Integer; Data: PPointer; 56 | Size: Integer): Integer; 57 | begin 58 | // Implicitly ignore current frame 59 | Inc(IgnoredFrames); 60 | if (WinXPDown) then 61 | begin 62 | // Windows XP only supports IgnoredFrames + Size < 63 63 | // https://msdn.microsoft.com/en-us/library/windows/desktop/bb204633(v=vs.85).aspx 64 | if IgnoredFrames + Size >= 63 then 65 | Size := 62 - IgnoredFrames; 66 | end; 67 | 68 | Result := RtlCaptureStackBackTrace(IgnoredFrames, Size, Data); 69 | end; 70 | 71 | initialization 72 | WinXPDown := not CheckWin32Version(6); 73 | 74 | end. 75 | -------------------------------------------------------------------------------- /Source/LeakCheck.Trace.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.Trace; 26 | 27 | {$I LeakCheck.inc} 28 | 29 | interface 30 | 31 | procedure Trace(const Msg: string); 32 | 33 | implementation 34 | uses 35 | {$IFDEF MSWINDOWS} 36 | Windows, 37 | {$ENDIF} 38 | {$IFDEF POSIX} 39 | Posix.Unistd, 40 | SysUtils, 41 | {$ENDIF} 42 | {$IFDEF ANDROID} 43 | Androidapi.Log, 44 | {$ENDIF} 45 | LeakCheck; 46 | 47 | {$IF CompilerVersion >= 25} // >= XE4 48 | {$LEGACYIFEND ON} 49 | {$IFEND} 50 | 51 | {$IFDEF LEAKCHECK_TRACE_FILE} 52 | var 53 | GOutput: TextFile; 54 | {$ENDIF} 55 | 56 | procedure Trace(const Msg: string); 57 | {$IF Defined(LEAKCHECK_TRACE_FILE)} 58 | begin 59 | if TTextRec(GOutput).Handle = 0 then 60 | begin 61 | Assign(GOutput, 'LeakCheck.trace'); 62 | Rewrite(GOutput); 63 | end; 64 | Writeln(GOutput, Msg); 65 | end; 66 | {$ELSEIF Defined(ANDROID)} 67 | const 68 | TAG: MarshaledAString = MarshaledAString('LeakCheck'); 69 | var 70 | m: TMarshaller; 71 | begin 72 | __android_log_write(ANDROID_LOG_WARN, TAG, m.AsAnsi(Msg).ToPointer); 73 | // Do not sleep here, it causes slowdown and we don't mind (much) if we loose 74 | // some messages. 75 | // usleep(1 * 1000); 76 | end; 77 | {$ELSEIF Defined(MSWINDOWS)} 78 | begin 79 | OutputDebugString(PChar(Msg)); 80 | end; 81 | {$ELSEIF Defined(POSIX)} 82 | begin 83 | WriteLn(ErrOutput, Msg); 84 | end; 85 | {$ELSE} 86 | {$MESSAGE FATAL 'Unsupported platform'} 87 | {$IFEND} 88 | 89 | {$IFDEF LEAKCHECK_TRACE_FILE} 90 | initialization 91 | finalization 92 | if TTextRec(GOutput).Handle <> 0 then 93 | Flush(GOutput); 94 | // Do not close the file in case it is needed by other units' finalization 95 | // we'll leak some memory and handles but since this is debugging function, 96 | // this is not an issue - it will be released by the system momentarily. 97 | {$ENDIF} 98 | 99 | end. 100 | -------------------------------------------------------------------------------- /Source/LeakCheck.Types.inc: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | type 26 | TFieldInfo = packed record 27 | TypeInfo: PPTypeInfo; 28 | case Integer of 29 | 0: ( Offset: Cardinal ); 30 | 1: ( _Dummy: NativeUInt ); 31 | end; 32 | 33 | PFieldTable = ^TFieldTable; 34 | TFieldTable = packed record 35 | X: Word; 36 | Size: Cardinal; 37 | Count: Cardinal; 38 | Fields: array [0..0] of TFieldInfo; 39 | end; 40 | 41 | PDynArrayRec = ^TDynArrayRec; 42 | TDynArrayRec = packed record 43 | {$IF SizeOf(Pointer) = 8} 44 | _Padding: Integer; // Make 16 byte align for payload.. 45 | {$IFEND} 46 | RefCnt: Integer; 47 | Length: NativeInt; 48 | end; 49 | 50 | PNativeUInt = ^NativeUInt; 51 | 52 | PValueData = ^TValueData; 53 | PValue = ^TValue; -------------------------------------------------------------------------------- /Source/LeakCheck.inc: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | {$IFNDEF LEAKCHECK_DEBUG} 26 | // Define so that users don't step through memory manager code if they do not 27 | // choose to. And also to make it a bit faster. 28 | {$DEBUGINFO OFF} 29 | {$OPTIMIZATION ON} 30 | {$INLINE ON} 31 | {$ENDIF} 32 | 33 | // Some internal types have smaller array boundaries. 34 | {$RANGECHECKS OFF} 35 | // Disable this as well to make the code faster and to ensure some internal 36 | // pointer arithmetics don't generate errors. 37 | {$OVERFLOWCHECKS OFF} 38 | 39 | {$IF CompilerVersion >= 25} // >= XE4 40 | {$LEGACYIFEND ON} 41 | {$IFEND} 42 | 43 | {$IF SizeOf(Pointer) = 4} 44 | {$ALIGN 4} 45 | {$ELSEIF SizeOf(Pointer) = 8} 46 | {$ALIGN 8} 47 | {$ELSE} 48 | {$MESSAGE FATAL 'Unsupported platform'} 49 | {$IFEND} 50 | 51 | {$MINENUMSIZE 1} 52 | 53 | -------------------------------------------------------------------------------- /Test/.gitignore: -------------------------------------------------------------------------------- 1 | *.dsk 2 | *.~dsk 3 | *.identcache 4 | *.local 5 | *.tvsconfig 6 | 7 | AndroidManifest.template.xml 8 | 9 | XE*/Win32 10 | XE*/Win64 11 | XE*/Android 12 | -------------------------------------------------------------------------------- /Test/LeakCheck.TestDUnit.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.TestDUnit; 26 | 27 | interface 28 | 29 | uses 30 | SysUtils, 31 | Rtti, 32 | TestFramework; 33 | 34 | type 35 | TLeakCheckConfiguration = record 36 | private 37 | {$I ..\..\Source\LeakCheck.Configuration.inc} 38 | end; 39 | 40 | TTestLeaks = class(TTestCase) 41 | published 42 | procedure TestNoLeaks; 43 | procedure TestWithLeaks; 44 | end; 45 | 46 | TTestSetup = class(TTestCase) 47 | protected 48 | FObj: Pointer; 49 | procedure SetUp; override; 50 | published 51 | procedure TestReleased; 52 | procedure TestNotReleased; 53 | end; 54 | 55 | TTestTeardown = class(TTestCase) 56 | protected 57 | FObj: Pointer; 58 | procedure TearDown; override; 59 | published 60 | procedure TestReleased; 61 | end; 62 | 63 | TTestTeardownThatLeaks = class(TTestCase) 64 | protected 65 | procedure TearDown; override; 66 | published 67 | procedure TestNotReleased; 68 | end; 69 | 70 | TTestStatusDoesNotLeak = class(TTestCase) 71 | published 72 | procedure TestStatus; 73 | end; 74 | 75 | TTestIgnoreTValue = class(TTestCase) 76 | published 77 | procedure TestCallsIgnoreForObject; 78 | procedure TestDoesNotCallIgnoreForNonObject; 79 | end; 80 | 81 | TTestIgnoreTMonitor = class(TTestCase) 82 | published 83 | procedure TestIgnoreTMonitor; 84 | end; 85 | 86 | TTestCorruptionDetection = class(TTestCase) 87 | private 88 | procedure CheckAV(Offset: NativeInt); 89 | published 90 | procedure TestFooter; 91 | procedure TestSeparator; 92 | end; 93 | 94 | implementation 95 | 96 | uses 97 | LeakCheck, 98 | LeakCheck.Utils; 99 | 100 | var 101 | KnownLeaks: TArray; 102 | 103 | type 104 | TTestCaseHelper = class helper for TTestCase 105 | procedure AddKnownLeak(Leak: Pointer); 106 | end; 107 | 108 | procedure TTestCaseHelper.AddKnownLeak(Leak: Pointer); 109 | var 110 | Len: Integer; 111 | begin 112 | Status('This test will fail due to memory leak which is expected'); 113 | TLeakCheck.BeginIgnore; 114 | Len := Length(KnownLeaks); 115 | SetLength(KnownLeaks, Len + 1); 116 | KnownLeaks[Len] := Leak; 117 | TLeakCheck.EndIgnore; 118 | end; 119 | 120 | { TTestLeaks } 121 | 122 | procedure TTestLeaks.TestNoLeaks; 123 | begin 124 | TObject.Create{$IFNDEF AUTOREFCOUNT}.Free{$ENDIF}; 125 | Check(True); 126 | end; 127 | 128 | procedure TTestLeaks.TestWithLeaks; 129 | var 130 | O: Pointer; 131 | begin 132 | {$IFDEF AUTOREFCOUNT} 133 | O := nil; 134 | {$ENDIF} 135 | TObject(O) := TObject.Create; 136 | AddKnownLeak(O); 137 | Check(True); 138 | end; 139 | 140 | { TTestSetup } 141 | 142 | procedure TTestSetup.SetUp; 143 | begin 144 | inherited; 145 | TObject(FObj) := TObject.Create; 146 | end; 147 | 148 | procedure TTestSetup.TestNotReleased; 149 | begin 150 | AddKnownLeak(FObj); 151 | Check(True); 152 | end; 153 | 154 | procedure TTestSetup.TestReleased; 155 | begin 156 | TObject(FObj).Free; 157 | Check(True); 158 | end; 159 | 160 | { TTestTeardown } 161 | 162 | procedure TTestTeardown.TearDown; 163 | begin 164 | inherited; 165 | TObject(FObj).Free; 166 | end; 167 | 168 | procedure TTestTeardown.TestReleased; 169 | begin 170 | TObject(FObj) := TObject.Create; 171 | Check(True); 172 | end; 173 | 174 | { TTestTeardownThatLeaks } 175 | 176 | procedure TTestTeardownThatLeaks.TearDown; 177 | var 178 | O: Pointer; 179 | begin 180 | inherited; 181 | {$IFDEF AUTOREFCOUNT} 182 | O := nil; 183 | {$ENDIF} 184 | TObject(O) := TObject.Create; 185 | AddKnownLeak(O); 186 | end; 187 | 188 | procedure TTestTeardownThatLeaks.TestNotReleased; 189 | begin 190 | Check(True); 191 | end; 192 | 193 | procedure FinalizeLeaks; 194 | var 195 | O: Pointer; 196 | begin 197 | for O in KnownLeaks do 198 | {$IFNDEF AUTOREFCOUNT} 199 | TObject(O).Free; 200 | {$ELSE} 201 | TObject(O).__ObjRelease; 202 | {$ENDIF} 203 | Finalize(KnownLeaks); 204 | end; 205 | 206 | { TTestStatusDoesNotLeak } 207 | 208 | procedure TTestStatusDoesNotLeak.TestStatus; 209 | var 210 | s: string; 211 | begin 212 | s := 'This is a status test'; 213 | UniqueString(s); // Make this a dynamic text 214 | Status(s); 215 | Check(True); 216 | end; 217 | 218 | type 219 | TValueDataImpl = class(TInterfacedObject, IValueData) 220 | private class var 221 | Dummy: Pointer; 222 | private 223 | FIsObject: Boolean; 224 | public 225 | function GetDataSize: Integer; 226 | procedure ExtractRawData(ABuffer: Pointer); 227 | procedure ExtractRawDataNoCopy(ABuffer: Pointer); 228 | function GetReferenceToRawData: Pointer; 229 | constructor Create(IsObject: Boolean); 230 | function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall; 231 | end; 232 | 233 | { TValueDataImpl } 234 | 235 | constructor TValueDataImpl.Create(IsObject: Boolean); 236 | begin 237 | inherited Create; 238 | FIsObject := IsObject; 239 | end; 240 | 241 | procedure TValueDataImpl.ExtractRawData(ABuffer: Pointer); 242 | begin 243 | 244 | end; 245 | 246 | procedure TValueDataImpl.ExtractRawDataNoCopy(ABuffer: Pointer); 247 | begin 248 | 249 | end; 250 | 251 | function TValueDataImpl.GetDataSize: Integer; 252 | begin 253 | Result := 0; 254 | end; 255 | 256 | function TValueDataImpl.GetReferenceToRawData: Pointer; 257 | begin 258 | Result := @Dummy; 259 | end; 260 | 261 | function TValueDataImpl.QueryInterface(const IID: TGUID; out Obj): HRESULT; 262 | begin 263 | if FIsObject then 264 | Result := inherited 265 | else 266 | Result := 1; 267 | end; 268 | 269 | { TTestIgnoreTValue } 270 | 271 | procedure TTestIgnoreTValue.TestCallsIgnoreForObject; 272 | var 273 | Snapshot: TLeakCheck.TSnapshot; 274 | Value: Rtti.TValueData; 275 | begin 276 | Snapshot.Create; 277 | Value.FTypeInfo := TypeInfo(TObject); 278 | Value.FValueData := TValueDataImpl.Create(True); 279 | IgnoreTValue(@Value); 280 | CheckEquals(0, Snapshot.LeakSize); 281 | end; 282 | 283 | procedure TTestIgnoreTValue.TestDoesNotCallIgnoreForNonObject; 284 | var 285 | Snapshot: TLeakCheck.TSnapshot; 286 | Value: Rtti.TValueData; 287 | begin 288 | Snapshot.Create; 289 | Value.FValueData := TValueDataImpl.Create(False); 290 | IgnoreTValue(@Value); 291 | CheckEquals(TValueDataImpl.InstanceSize, Snapshot.LeakSize); 292 | end; 293 | 294 | { TTestIgnoreTMonitor } 295 | 296 | procedure TTestIgnoreTMonitor.TestIgnoreTMonitor; 297 | var 298 | Inst: TObject; 299 | begin 300 | Inst := TObject.Create; 301 | TMonitor.Enter(Inst); 302 | TMonitor.Exit(Inst); 303 | AddKnownLeak(Inst); 304 | RegisterExpectedMemoryLeak(Inst); 305 | IgnoreAllManagedFields(Inst, TObject); 306 | Pointer(Inst) := nil; 307 | Check(true); 308 | end; 309 | 310 | { TTestCorruptionDetection } 311 | 312 | procedure TTestCorruptionDetection.CheckAV(Offset: NativeInt); 313 | var 314 | Data: PByte; 315 | begin 316 | GetMem(Data, 1); 317 | (Data + Offset)^ := $AA; 318 | try 319 | FreeMem(Data); 320 | Check(False, 'EAccessViolation expected'); 321 | except 322 | on EAccessViolation do 323 | Check(True); 324 | else Check(False, 'EAccessViolation expected, got different'); 325 | end; 326 | end; 327 | 328 | procedure TTestCorruptionDetection.TestFooter; 329 | begin 330 | {$IF TLeakCheckConfiguration.FooterSize > 0} 331 | CheckAV(1); 332 | CheckAV(TLeakCheckConfiguration.FooterSize * SizeOf(Pointer)); 333 | {$IFEND} 334 | end; 335 | 336 | procedure TTestCorruptionDetection.TestSeparator; 337 | begin 338 | {$IF TLeakCheckConfiguration.SeparatorSize > 0} 339 | CheckAV(-1); 340 | CheckAV(-TLeakCheckConfiguration.SeparatorSize * SizeOf(Pointer)); 341 | {$IFEND} 342 | end; 343 | 344 | initialization 345 | RegisterTests([ 346 | TTestLeaks.Suite, 347 | TTestSetup.Suite, 348 | TTestTeardown.Suite, 349 | TTestTeardownThatLeaks.Suite, 350 | TTestStatusDoesNotLeak.Suite, 351 | TTestIgnoreTValue.Suite, 352 | TTestIgnoreTMonitor.Suite, 353 | TTestCorruptionDetection.Suite 354 | ]); 355 | 356 | finalization 357 | FinalizeLeaks; 358 | end. 359 | -------------------------------------------------------------------------------- /Test/LeakCheck.TestDUnitX.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.TestDUnitX; 26 | 27 | interface 28 | 29 | uses 30 | LeakCheck, 31 | SysUtils, 32 | DUnitX.TestFramework, 33 | DUnitX.Attributes; 34 | 35 | type 36 | {$M+} 37 | TTestLeaks = class 38 | published 39 | procedure TestNoLeaks; 40 | procedure TestWithLeaks; 41 | end; 42 | 43 | TTestSetup = class 44 | protected 45 | FObj: Pointer; 46 | public 47 | [SetUp] 48 | procedure SetUp; 49 | published 50 | procedure TestReleased; 51 | procedure TestNotReleased; 52 | end; 53 | 54 | TTestTeardown = class 55 | protected 56 | FObj: Pointer; 57 | public 58 | [TearDown] 59 | procedure TearDown; 60 | published 61 | procedure TestReleased; 62 | end; 63 | 64 | TTestTeardownThatLeaks = class 65 | public 66 | [TearDown] 67 | procedure TearDown; 68 | published 69 | procedure TestNotReleased; 70 | end; 71 | 72 | TTestExceptionDisablesLeakIgnoreBase = class 73 | public 74 | destructor Destroy; override; 75 | 76 | end; 77 | 78 | TTestExceptionDisablesLeakIgnore = class(TTestExceptionDisablesLeakIgnoreBase) 79 | published 80 | procedure Test; 81 | end; 82 | 83 | TTestSetUpExceptionDisablesLeakIgnore = class(TTestExceptionDisablesLeakIgnoreBase) 84 | public 85 | [SetUp] 86 | procedure SetUp; 87 | published 88 | procedure Test; 89 | end; 90 | 91 | TTestTearDownExceptionDisablesLeakIgnore = class(TTestExceptionDisablesLeakIgnoreBase) 92 | public 93 | [TearDown] 94 | procedure TearDown; 95 | published 96 | procedure Test; 97 | end; 98 | 99 | TTestStatusDoesNotLeak = class 100 | published 101 | procedure TestStatus; 102 | end; 103 | 104 | implementation 105 | 106 | uses 107 | LeakCheck.Utils, 108 | TypInfo, 109 | Rtti; 110 | 111 | {$ASSERTIONS ON} 112 | 113 | var 114 | KnownLeaks: TArray; 115 | 116 | procedure AddKnownLeak(Leak: Pointer); 117 | var 118 | Len: Integer; 119 | begin 120 | Len := Length(KnownLeaks); 121 | SetLength(KnownLeaks, Len + 1); 122 | KnownLeaks[Len] := Leak; 123 | IgnoreDynamicArray(KnownLeaks); 124 | end; 125 | 126 | { TTestLeaks } 127 | 128 | procedure TTestLeaks.TestNoLeaks; 129 | begin 130 | TObject.Create{$IFNDEF AUTOREFCOUNT}.Free{$ENDIF}; 131 | Assert.Pass; 132 | end; 133 | 134 | procedure TTestLeaks.TestWithLeaks; 135 | var 136 | O: Pointer; 137 | begin 138 | {$IFDEF AUTOREFCOUNT} 139 | O := nil; 140 | {$ENDIF} 141 | TObject(O) := TObject.Create; 142 | AddKnownLeak(O); 143 | Assert.Pass; 144 | end; 145 | 146 | { TTestSetup } 147 | 148 | procedure TTestSetup.SetUp; 149 | begin 150 | inherited; 151 | TObject(FObj) := TObject.Create; 152 | end; 153 | 154 | procedure TTestSetup.TestNotReleased; 155 | begin 156 | AddKnownLeak(FObj); 157 | Assert.Pass; 158 | end; 159 | 160 | procedure TTestSetup.TestReleased; 161 | begin 162 | TObject(FObj).Free; 163 | Assert.Pass; 164 | end; 165 | 166 | procedure TTestTeardown.TearDown; 167 | begin 168 | inherited; 169 | TObject(FObj).Free; 170 | end; 171 | 172 | procedure TTestTeardown.TestReleased; 173 | begin 174 | TObject(FObj) := TObject.Create; 175 | Assert.Pass; 176 | end; 177 | 178 | { TTestTeardownThatLeaks } 179 | 180 | procedure TTestTeardownThatLeaks.TearDown; 181 | var 182 | O: Pointer; 183 | begin 184 | inherited; 185 | {$IFDEF AUTOREFCOUNT} 186 | O := nil; 187 | {$ENDIF} 188 | TObject(O) := TObject.Create; 189 | AddKnownLeak(O); 190 | end; 191 | 192 | procedure TTestTeardownThatLeaks.TestNotReleased; 193 | begin 194 | Assert.Pass; 195 | end; 196 | 197 | { TTestStatusDoesNotLeak } 198 | 199 | procedure TTestStatusDoesNotLeak.TestStatus; 200 | var 201 | s: string; 202 | begin 203 | s := 'This is a status test'; 204 | UniqueString(s); // Make this a dynamic text 205 | with TDUnitX.CurrentRunner do 206 | Status(s); 207 | Assert.Pass; 208 | end; 209 | 210 | { TTestExceptionDisablesLeakIgnoreBase } 211 | 212 | destructor TTestExceptionDisablesLeakIgnoreBase.Destroy; 213 | var 214 | Snapshot: TLeakCheck.TSnapshot; 215 | s: string; 216 | begin 217 | Snapshot.Create; 218 | SetLength(s, 1); 219 | System.Assert(Snapshot.LeakSize > 0); 220 | s:=''; 221 | inherited; 222 | end; 223 | 224 | { TTestExceptionDisablesLeakIgnore } 225 | 226 | procedure TTestExceptionDisablesLeakIgnore.Test; 227 | begin 228 | Abort; 229 | end; 230 | 231 | { TTestSetUpExceptionDisablesLeakIgnore } 232 | 233 | procedure TTestSetUpExceptionDisablesLeakIgnore.SetUp; 234 | begin 235 | Abort; 236 | end; 237 | 238 | procedure TTestSetUpExceptionDisablesLeakIgnore.Test; 239 | begin 240 | 241 | end; 242 | 243 | { TTestTearDownExceptionDisablesLeakIgnore } 244 | 245 | procedure TTestTearDownExceptionDisablesLeakIgnore.TearDown; 246 | begin 247 | Abort; 248 | end; 249 | 250 | procedure TTestTearDownExceptionDisablesLeakIgnore.Test; 251 | begin 252 | 253 | end; 254 | 255 | procedure FinalizeLeaks; 256 | var 257 | O: Pointer; 258 | begin 259 | for O in KnownLeaks do 260 | {$IFNDEF AUTOREFCOUNT} 261 | TObject(O).Free; 262 | {$ELSE} 263 | TObject(O).__ObjRelease; 264 | {$ENDIF} 265 | Finalize(KnownLeaks); 266 | end; 267 | 268 | initialization 269 | TDUnitX.RegisterTestFixture(TTestLeaks); 270 | TDUnitX.RegisterTestFixture(TTestSetup); 271 | TDUnitX.RegisterTestFixture(TTestTeardown); 272 | TDUnitX.RegisterTestFixture(TTestTeardownThatLeaks); 273 | TDUnitX.RegisterTestFixture(TTestExceptionDisablesLeakIgnore); 274 | TDUnitX.RegisterTestFixture(TTestSetUpExceptionDisablesLeakIgnore); 275 | TDUnitX.RegisterTestFixture(TTestTearDownExceptionDisablesLeakIgnore); 276 | TDUnitX.RegisterTestFixture(TTestStatusDoesNotLeak); 277 | 278 | finalization 279 | FinalizeLeaks; 280 | 281 | end. 282 | -------------------------------------------------------------------------------- /Test/LeakCheck.TestForm.fmx: -------------------------------------------------------------------------------- 1 | object frmLeakCheckTest: TfrmLeakCheckTest 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 480 6 | ClientWidth = 640 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | DesignerMasterStyle = 0 11 | object lblText: TText 12 | Align = Center 13 | AutoSize = True 14 | Size.Width = 261.490875244140600000 15 | Size.Height = 26.601562500000000000 16 | Size.PlatformDefault = False 17 | Text = 'Testing form, will now close...' 18 | TextSettings.Font.Size = 20.000000000000000000 19 | TextSettings.WordWrap = False 20 | end 21 | object tmrClose: TTimer 22 | Interval = 500 23 | OnTimer = tmrCloseTimer 24 | Left = 24 25 | Top = 36 26 | end 27 | end 28 | -------------------------------------------------------------------------------- /Test/LeakCheck.TestForm.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.TestForm; 26 | 27 | interface 28 | 29 | uses 30 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 31 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects; 32 | 33 | type 34 | TfrmLeakCheckTest = class(TForm) 35 | tmrClose: TTimer; 36 | lblText: TText; 37 | procedure tmrCloseTimer(Sender: TObject); 38 | private 39 | { Private declarations } 40 | public 41 | { Public declarations } 42 | end; 43 | 44 | var 45 | frmLeakCheckTest: TfrmLeakCheckTest; 46 | 47 | implementation 48 | 49 | {$R *.fmx} 50 | 51 | procedure TfrmLeakCheckTest.tmrCloseTimer(Sender: TObject); 52 | begin 53 | tmrClose.Enabled := False; 54 | Close; 55 | end; 56 | 57 | end. 58 | -------------------------------------------------------------------------------- /Test/LeakCheck.TestUnit.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | unit LeakCheck.TestUnit; 26 | 27 | {$ASSERTIONS ON} 28 | 29 | interface 30 | 31 | procedure RunTests; 32 | 33 | implementation 34 | 35 | uses LeakCheck; 36 | 37 | {$I ../Source/LeakCheck.Configuration.inc} 38 | 39 | var 40 | LeakSnapshot: Pointer; 41 | 42 | procedure TestFirstLast; 43 | var 44 | P: Pointer; 45 | L: TLeaks; 46 | begin 47 | L := TLeakCheck.GetLeaks(LeakSnapshot); 48 | Assert(L.Length = 0); 49 | GetMem(P, 16); 50 | L := TLeakCheck.GetLeaks(LeakSnapshot); 51 | Assert(L.Length = 1); 52 | Assert(L[0] = P); 53 | L.Free; 54 | FreeMem(P); 55 | L := TLeakCheck.GetLeaks(LeakSnapshot); 56 | Assert(L.Length = 0); 57 | end; 58 | 59 | procedure TestLast; 60 | var 61 | P1, P2, P3: Pointer; 62 | L: TLeaks; 63 | begin 64 | GetMem(P1, 16); 65 | GetMem(P2, 16); 66 | GetMem(P3, 16); 67 | FreeMem(P3); 68 | L := TLeakCheck.GetLeaks(LeakSnapshot); 69 | Assert(L.Length = 2); 70 | Assert(L[0] = P1); 71 | Assert(L[1] = P2); 72 | L.Free; 73 | FreeMem(P2); 74 | FreeMem(P1); 75 | end; 76 | 77 | procedure TestFirst; 78 | var 79 | P1, P2, P3: Pointer; 80 | L: TLeaks; 81 | begin 82 | GetMem(P1, 16); 83 | GetMem(P2, 16); 84 | GetMem(P3, 16); 85 | FreeMem(P1); 86 | L := TLeakCheck.GetLeaks(LeakSnapshot); 87 | Assert(L.Length = 2); 88 | Assert(L[0] = P2); 89 | Assert(L[1] = P3); 90 | L.Free; 91 | FreeMem(P2); 92 | FreeMem(P3); 93 | end; 94 | 95 | procedure TestMid; 96 | var 97 | P1, P2, P3: Pointer; 98 | L: TLeaks; 99 | begin 100 | GetMem(P1, 16); 101 | GetMem(P2, 16); 102 | GetMem(P3, 16); 103 | FreeMem(P2); 104 | L := TLeakCheck.GetLeaks(LeakSnapshot); 105 | Assert(L.Length = 2); 106 | Assert(L[0] = P1); 107 | Assert(L[1] = P3); 108 | L.Free; 109 | FreeMem(P1); 110 | FreeMem(P3); 111 | end; 112 | 113 | procedure TestReport; 114 | var 115 | P, PP: PByte; 116 | Leak: LeakString; 117 | i: Integer; 118 | {$IFNDEF NEXTGEN} 119 | s: AnsiString; 120 | {$ENDIF} 121 | us: UnicodeString; 122 | o: TObject; 123 | intf: IInterface; 124 | begin 125 | GetMem(P, 48); 126 | PP := P; 127 | for i := 0 to 48 - 1 do 128 | begin 129 | PP^ := i; 130 | Inc(PP); 131 | end; 132 | TLeakCheck.Report(LeakSnapshot, True); 133 | Leak := TLeakCheck.GetReport(LeakSnapshot); 134 | FreeMem(P); 135 | Assert(not Leak.IsEmpty); 136 | Leak.Free; 137 | TLeakCheck.Report(LeakSnapshot); 138 | Leak := TLeakCheck.GetReport(LeakSnapshot); 139 | Assert(Leak.IsEmpty); 140 | Leak.Free; 141 | 142 | {$IFNDEF NEXTGEN} 143 | s := 'ATest'; 144 | UniqueString(s); 145 | TLeakCheck.Report(LeakSnapshot); 146 | s := ''; 147 | Assert(TLeakCheck.GetReport(LeakSnapshot).IsEmpty); 148 | {$ENDIF} 149 | 150 | us := 'UTest'; 151 | UniqueString(us); 152 | TLeakCheck.Report(LeakSnapshot); 153 | us := ''; 154 | Assert(TLeakCheck.GetReport(LeakSnapshot).IsEmpty); 155 | 156 | o := TObject.Create; 157 | TLeakCheck.Report(LeakSnapshot); 158 | o.Free; 159 | Assert(TLeakCheck.GetReport(LeakSnapshot).IsEmpty); 160 | 161 | intf := TInterfacedObject.Create; 162 | TLeakCheck.Report(LeakSnapshot); 163 | intf := nil; 164 | Assert(TLeakCheck.GetReport(LeakSnapshot).IsEmpty); 165 | end; 166 | 167 | procedure TestIgnores; 168 | var 169 | o: Pointer; 170 | intf: IInterface; 171 | s: string; 172 | P: Pointer; 173 | L: TLeaks; 174 | begin 175 | o := TInterfacedObject.Create; 176 | intf := TInterfacedObject(o); 177 | s := 'Leak'; 178 | UniqueString(s); 179 | P:=AllocMem(48); 180 | TLeakCheck.IgnoredLeakTypes := [tkUString, tkClass, tkUnknown]; 181 | Assert(TLeakCheck.GetLeaks(LeakSnapshot).IsEmpty); 182 | 183 | TLeakCheck.IgnoredLeakTypes := [tkUString, tkClass]; 184 | L := TLeakCheck.GetLeaks(LeakSnapshot); 185 | Assert(not L.IsEmpty); 186 | Assert(L[0] = P); 187 | L.Free; 188 | 189 | TLeakCheck.IgnoredLeakTypes := [tkUString, tkUnknown]; 190 | L := TLeakCheck.GetLeaks(LeakSnapshot); 191 | Assert(not L.IsEmpty); 192 | Assert(L[0] = o); 193 | L.Free; 194 | 195 | TLeakCheck.IgnoredLeakTypes := [tkClass, tkUnknown]; 196 | L := TLeakCheck.GetLeaks(LeakSnapshot); 197 | Assert(not L.IsEmpty); 198 | Assert(L[0] = Pointer(NativeUInt(Pointer(s)) - TLeakCheck.StringSkew)); 199 | L.Free; 200 | 201 | FreeMem(P); 202 | TLeakCheck.IgnoredLeakTypes := []; 203 | end; 204 | 205 | type 206 | TTestFreedObject = class(TObject) 207 | protected 208 | procedure VirtualProc1; virtual; 209 | procedure VirtualProc2; virtual; 210 | procedure VirtualProc3; virtual; 211 | end; 212 | 213 | { TTestFreedObject } 214 | 215 | procedure TTestFreedObject.VirtualProc1; 216 | begin 217 | Assert(False); 218 | end; 219 | 220 | procedure TTestFreedObject.VirtualProc2; 221 | begin 222 | Assert(False); 223 | end; 224 | 225 | procedure TTestFreedObject.VirtualProc3; 226 | begin 227 | Assert(False); 228 | end; 229 | 230 | procedure TestObjectCleanup; 231 | var 232 | O: TObject; 233 | F: TTestFreedObject; 234 | P: Pointer; 235 | begin 236 | O := TObject.Create; 237 | P := O; 238 | O.Free; 239 | Assert(TLeakCheck.GetObjectClass(TObject(P)) = nil); 240 | Assert(TObject(P).ClassType.ClassParent = TLeakCheck.TFreedObject); 241 | Assert(TObject(P).ClassType.ClassName = 'TFreedObjectImpl'); 242 | F := TTestFreedObject.Create; 243 | F.Destroy; //Try to use both Destroy and Free (see below) 244 | try 245 | F.VirtualProc1; 246 | Assert(false); 247 | except 248 | end; 249 | Pointer(F) := nil; 250 | // Allocate again to ensure we don't have the info block corrupted 251 | F := TTestFreedObject.Create; 252 | P := F; 253 | F.Free; 254 | try 255 | TTestFreedObject(P).Destroy; 256 | Assert(false); 257 | except 258 | end; 259 | try 260 | TTestFreedObject(P).VirtualProc3; 261 | Assert(false); 262 | except 263 | end; 264 | try 265 | TTestFreedObject(P).Destroy; 266 | Assert(false); 267 | except 268 | end; 269 | end; 270 | 271 | type 272 | ITestInterface = interface 273 | procedure VirtualProc1; 274 | procedure VirtualProc2; 275 | procedure NonVirtualProc1; 276 | procedure NonVirtualProc2; 277 | procedure StdProc; stdcall; 278 | end; 279 | 280 | TTestFreedIntfObject = class(TInterfacedObject, ITestInterface, IInterface) 281 | protected 282 | procedure VirtualProc1; virtual; 283 | procedure VirtualProc2; virtual; 284 | procedure NonVirtualProc1; 285 | procedure NonVirtualProc2; 286 | procedure StdProc; stdcall; 287 | end; 288 | 289 | { TTestFreedIntfObject } 290 | 291 | procedure TTestFreedIntfObject.NonVirtualProc1; 292 | begin 293 | Assert(False); 294 | end; 295 | 296 | procedure TTestFreedIntfObject.NonVirtualProc2; 297 | begin 298 | Assert(False); 299 | end; 300 | 301 | procedure TTestFreedIntfObject.StdProc; 302 | begin 303 | Assert(False); 304 | end; 305 | 306 | procedure TTestFreedIntfObject.VirtualProc1; 307 | begin 308 | Assert(False); 309 | end; 310 | 311 | procedure TTestFreedIntfObject.VirtualProc2; 312 | begin 313 | Assert(False); 314 | end; 315 | 316 | procedure TestInterfaceCleanup; 317 | var 318 | O: TTestFreedIntfObject; 319 | I: ITestInterface; 320 | begin 321 | O := TTestFreedIntfObject.Create; 322 | // O.VirtualProc2; 323 | // O.NonVirtualProc2; 324 | I := O; 325 | {$IFDEF AUTOREFCOUNT} 326 | O := nil; 327 | {$ENDIF} 328 | I._Release; 329 | try 330 | I._Release; 331 | Assert(False); 332 | except 333 | end; 334 | Pointer(I) := nil; 335 | I := TTestFreedIntfObject.Create; 336 | I._Release; 337 | try 338 | I.StdProc; 339 | Assert(False); 340 | except 341 | end; 342 | Pointer(I) := nil; 343 | I := TTestFreedIntfObject.Create; 344 | I._Release; 345 | try 346 | I.VirtualProc2; 347 | Assert(False); 348 | except 349 | end; 350 | Pointer(I) := nil; 351 | I := TTestFreedIntfObject.Create; 352 | I._Release; 353 | try 354 | I.NonVirtualProc2; 355 | Assert(False); 356 | except 357 | end; 358 | Pointer(I) := nil; 359 | end; 360 | 361 | procedure RunTests; 362 | begin 363 | LeakSnapshot := TLeakCheck.CreateSnapshot; 364 | TestFirstLast; 365 | TestLast; 366 | TestFirst; 367 | TestMid; 368 | TestReport; 369 | TestIgnores; 370 | {$IFNDEF LEAKCHECK_DEFER} 371 | {$IF EnableVirtualCallsOnFreedObjectInterception} 372 | TestObjectCleanup; 373 | {$IFEND} 374 | {$IF EnableInterfaceCallsOnFreedObjectInterception} 375 | TestInterfaceCleanup; 376 | {$IFEND} 377 | {$ENDIF} 378 | end; 379 | 380 | end. 381 | -------------------------------------------------------------------------------- /Test/XE/TestGroup.groupproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {1D710B2F-CD49-426A-A70B-95E1C15AF843} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | Default.Personality.12 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /Test/XE/TestProject.dpr: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | program TestProject; 26 | 27 | uses 28 | {$IFDEF WIN32} 29 | // If used together with LeakCheck registering expected leaks may not bubble 30 | // to the internal system memory manager and thus may be reported to the user. 31 | // This behavior is due to FastMM not calling parent RegisterExpectedMemoryLeak 32 | // and is not LeakCheck issue. This is only exposed if LEAKCHECK_DEFER is 33 | // defined. 34 | {$IFDEF LEAKCHECK_DEFER} 35 | FastMM4, 36 | {$ENDIF} 37 | {$ENDIF } 38 | LeakCheck in '..\..\Source\LeakCheck.pas', 39 | LeakCheck.Utils in '..\..\Source\LeakCheck.Utils.pas', 40 | TestFramework in '..\..\External\DUnit\TestFramework.pas', 41 | TestInsight.DUnit, 42 | LeakCheck.TestUnit in '..\LeakCheck.TestUnit.pas', 43 | LeakCheck.TestDUnit in '..\LeakCheck.TestDUnit.pas', 44 | LeakCheck.DUnit in '..\..\Source\LeakCheck.DUnit.pas', 45 | LeakCheck.Collections in '..\..\Source\LeakCheck.Collections.pas', 46 | LeakCheck.Cycle in '..\..\Source\LeakCheck.Cycle.pas', 47 | LeakCheck.Cycle.Utils in '..\..\Source\LeakCheck.Cycle.Utils.pas', 48 | LeakCheck.DUnitCycle in '..\..\Source\LeakCheck.DUnitCycle.pas', 49 | {$IFDEF MSWINDOWS} 50 | LeakCheck.Trace.DbgHelp in '..\..\Source\LeakCheck.Trace.DbgHelp.pas', 51 | LeakCheck.Trace.WinApi in '..\..\Source\LeakCheck.Trace.WinApi.pas', 52 | LeakCheck.Trace.Jcl in '..\..\Source\LeakCheck.Trace.Jcl.pas', 53 | {$ENDIF} 54 | LeakCheck.TestCycle in '..\LeakCheck.TestCycle.pas'; 55 | 56 | {$R *.res} 57 | 58 | begin 59 | // Simple test of functionality 60 | RunTests; 61 | 62 | ReportMemoryLeaksOnShutdown := True; 63 | 64 | //TLeakCheck.GetStackTraceProc := WinApiStackTrace; 65 | //TLeakCheck.GetStackTraceProc := DbgHelpStackTrace; 66 | TLeakCheck.GetStackTraceProc := JclRawStackTrace; 67 | //TLeakCheck.GetStackTraceProc := JclFramesStackTrace; 68 | TLeakCheck.GetStackTraceFormatterProc := JclStackTraceFormatter; 69 | 70 | // DUnit integration 71 | {$IFDEF WEAKREF} 72 | TLeakCheck.IgnoredLeakTypes := [tkUnknown]; 73 | {$ENDIF} 74 | TLeakCheckCycleMonitor.UseExtendedRtti := True; 75 | MemLeakMonitorClass := TLeakCheckCycleGraphMonitor; 76 | RunRegisteredTests; 77 | end. 78 | 79 | -------------------------------------------------------------------------------- /Test/XE/TestProject.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {75899CB4-E3C4-4F01-B8EE-3C98C17A3369} 4 | TestProject.dpr 5 | 12.3 6 | True 7 | Debug 8 | Win32 9 | Console 10 | None 11 | DCC32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | true 29 | true 30 | $(JCL_DIR)\include;$(JCL_DIR)\common;$(JCL_DIR)\windows;$(DCC_UnitSearchPath) 31 | 3 32 | true 33 | LEAKCHECK_DEBUG;TESTINSIGHT;NO_MESSAGEBOX;$(DCC_Define) 34 | 00400000 35 | .\$(Platform)\$(Config) 36 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;$(DCC_UnitAlias) 37 | .\$(Platform)\$(Config) 38 | false 39 | false 40 | false 41 | false 42 | false 43 | 44 | 45 | DEBUG;$(DCC_Define) 46 | false 47 | true 48 | 49 | 50 | false 51 | RELEASE;$(DCC_Define) 52 | 0 53 | false 54 | 55 | 56 | 57 | MainSource 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 |
$IFDEF MSWINDOWS
70 | 71 | 72 | 73 | 74 | 75 | 76 | Cfg_2 77 | Base 78 | 79 | 80 | Base 81 | 82 | 83 | Cfg_1 84 | Base 85 | 86 | 87 | 88 | 89 | 90 | Delphi.Personality.12 91 | 92 | 93 | 94 | 95 | False 96 | False 97 | 1 98 | 0 99 | 0 100 | 0 101 | False 102 | False 103 | False 104 | False 105 | False 106 | 1029 107 | 1250 108 | 109 | 110 | 111 | 112 | 1.0.0.0 113 | 114 | 115 | 116 | 117 | 118 | 1.0.0.0 119 | 120 | 121 | 122 | TestProject.dpr 123 | 124 | 125 | 126 | True 127 | 128 | 129 | 12 130 | 131 | 132 | -------------------------------------------------------------------------------- /Test/XE/TestProject.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shadow-cs/delphi-leakcheck/67cc1bdfb670242b5b15d5942174c0024d7117b2/Test/XE/TestProject.res -------------------------------------------------------------------------------- /Test/XE/TestProjectX.dpr: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | program TestProjectX; 26 | 27 | // Make sure to have DUnitX in your global search path or point DUNITX_DIR 28 | // environmental variable to DUnitX base source directory. 29 | 30 | // Note that in order to run this project you have to have the updated DUnitX 31 | // framework that supports extended leak checking. 32 | 33 | uses 34 | {$IFDEF WIN32} 35 | FastMM4, 36 | {$ENDIF } 37 | LeakCheck in '..\..\Source\LeakCheck.pas', 38 | LeakCheck.Utils in '..\..\Source\LeakCheck.Utils.pas', 39 | DUnitX.TestFramework, 40 | DUnitX.IoC, 41 | TestInsight.DUnitX, 42 | LeakCheck.TestDUnitX in '..\LeakCheck.TestDUnitX.pas', 43 | LeakCheck.Collections in '..\..\Source\LeakCheck.Collections.pas', 44 | LeakCheck.Cycle in '..\..\Source\LeakCheck.Cycle.pas', 45 | LeakCheck.Cycle.Utils in '..\..\Source\LeakCheck.Cycle.Utils.pas', 46 | DUnitX.MemoryLeakMonitor.LeakCheck in '..\..\External\DUnitX\DUnitX.MemoryLeakMonitor.LeakCheck.pas', 47 | DUnitX.MemoryLeakMonitor.LeakCheckCycle in '..\..\External\DUnitX\DUnitX.MemoryLeakMonitor.LeakCheckCycle.pas', 48 | {$IFDEF MSWINDOWS} 49 | {$IFDEF CPUX32} 50 | LeakCheck.Trace.DbgHelp in '..\..\Source\LeakCheck.Trace.DbgHelp.pas', 51 | {$ENDIF } 52 | LeakCheck.Trace.WinApi in '..\..\Source\LeakCheck.Trace.WinApi.pas', 53 | LeakCheck.Trace.Jcl in '..\..\Source\LeakCheck.Trace.Jcl.pas', 54 | LeakCheck.MapFile in '..\..\Source\LeakCheck.MapFile.pas', 55 | LeakCheck.Trace.Map in '..\..\Source\LeakCheck.Trace.Map.pas', 56 | {$ENDIF } 57 | {$IFDEF POSIX} 58 | LeakCheck.Trace.Backtrace in '..\..\Source\LeakCheck.Trace.Backtrace.pas', 59 | {$ENDIF } 60 | LeakCheck.TestCycle in '..\LeakCheck.TestCycle.pas'; 61 | 62 | procedure Run; 63 | begin 64 | ReportMemoryLeaksOnShutdown := True; 65 | 66 | {$IFDEF MSWINDOWS} 67 | {$IFDEF CPUX64} 68 | TLeakCheck.GetStackTraceProc := WinApiStackTrace; 69 | {$ELSE} 70 | TLeakCheck.GetStackTraceProc := JclRawStackTrace; 71 | {$ENDIF} 72 | TLeakCheck.GetStackTraceFormatterProc := MapStackTraceFormatter; 73 | {$ENDIF} 74 | {$IFDEF POSIX} 75 | TLeakCheck.GetStackTraceProc := BacktraceStackTrace; 76 | TLeakCheck.GetStackTraceFormatterProc := PosixProcStackTraceFormatter; 77 | {$ENDIF} 78 | 79 | TDUnitX.RegisterTestFixture(TTestCycle); 80 | TDUnitX.RegisterTestFixture(TTestLeaksWithACycle); 81 | TDUnitX.RegisterTestFixture(TTestIgnoreGraphSimple); 82 | TDUnitX.RegisterTestFixture(TTestIgnoreGraphComplex); 83 | TDUnitXIoC.DefaultContainer.RegisterType( 84 | function : IMemoryLeakMonitor 85 | begin 86 | result := TDUnitXLeakCheckGraphMemoryLeakMonitor.Create; 87 | end); 88 | RunRegisteredTests; 89 | end; 90 | 91 | begin 92 | Run; 93 | end. 94 | -------------------------------------------------------------------------------- /Test/XE/TestProjectX.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {674ED35D-807D-471A-A95A-644D415829CE} 4 | TestProjectX.dpr 5 | 12.3 6 | True 7 | Debug 8 | Win32 9 | Console 10 | None 11 | DCC32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | 3 28 | $(DUNITX_DIR);$(JCL_DIR)\include;$(JCL_DIR)\common;$(JCL_DIR)\windows;$(DCC_UnitSearchPath) 29 | LEAKCHECK_DEBUG;TESTINSIGHT;NO_MESSAGEBOX;DUNITX-DEBUG;DUNITX;$(DCC_Define) 30 | 00400000 31 | .\$(Platform)\$(Config) 32 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;$(DCC_UnitAlias) 33 | .\$(Platform)\$(Config) 34 | false 35 | false 36 | false 37 | false 38 | false 39 | 40 | 41 | LEAKCHECK_DEFER;CHECK_LEAKS;DEBUG;$(DCC_Define) 42 | false 43 | true 44 | 45 | 46 | false 47 | RELEASE;$(DCC_Define) 48 | 0 49 | false 50 | 51 | 52 | 53 | MainSource 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | Cfg_2 70 | Base 71 | 72 | 73 | Base 74 | 75 | 76 | Cfg_1 77 | Base 78 | 79 | 80 | 81 | 82 | 83 | Delphi.Personality.12 84 | 85 | 86 | 87 | 88 | False 89 | False 90 | 1 91 | 0 92 | 0 93 | 0 94 | False 95 | False 96 | False 97 | False 98 | False 99 | 1029 100 | 1250 101 | 102 | 103 | 104 | 105 | 1.0.0.0 106 | 107 | 108 | 109 | 110 | 111 | 1.0.0.0 112 | 113 | 114 | 115 | TestProjectX.dpr 116 | 117 | 118 | 119 | True 120 | 121 | 122 | 12 123 | 124 | 125 | -------------------------------------------------------------------------------- /Test/XE6/TestProject.deployproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 12 5 | 6 | 7 | 8 | 9 | TestProject\library\lib\mips\ 10 | libTestProject.so 11 | 1 12 | 13 | 14 | True 15 | 16 | 17 | TestProject\res\drawable-mdpi\ 18 | ic_launcher.png 19 | 1 20 | 21 | 22 | True 23 | 24 | 25 | TestProject\ 26 | AndroidManifest.xml 27 | 1 28 | 29 | 30 | True 31 | 32 | 33 | TestProject\classes\ 34 | classes.dex 35 | 1 36 | 37 | 38 | True 39 | 40 | 41 | TestProject\res\drawable-hdpi\ 42 | ic_launcher.png 43 | 1 44 | 45 | 46 | True 47 | 48 | 49 | TestProject\ 50 | AndroidManifest.xml 51 | 1 52 | 53 | 54 | True 55 | 56 | 57 | TestProject\classes\ 58 | classes.dex 59 | 1 60 | 61 | 62 | True 63 | 64 | 65 | TestProject\res\drawable-xxhdpi\ 66 | ic_launcher.png 67 | 1 68 | 69 | 70 | True 71 | 72 | 73 | TestProject\library\lib\mips\ 74 | libTestProject.so 75 | 1 76 | 77 | 78 | True 79 | 80 | 81 | TestProject\res\drawable-xhdpi\ 82 | ic_launcher.png 83 | 1 84 | 85 | 86 | True 87 | 88 | 89 | TestProject\library\lib\x86\ 90 | libTestProject.so 91 | 1 92 | 93 | 94 | True 95 | 96 | 97 | TestProject\library\lib\armeabi-v7a\ 98 | gdbserver 99 | 1 100 | 101 | 102 | True 103 | 104 | 105 | TestProject\library\lib\armeabi\ 106 | libTestProject.so 107 | 1 108 | 109 | 110 | True 111 | 112 | 113 | TestProject\res\drawable-ldpi\ 114 | ic_launcher.png 115 | 1 116 | 117 | 118 | True 119 | 120 | 121 | TestProject\res\drawable-mdpi\ 122 | ic_launcher.png 123 | 1 124 | 125 | 126 | True 127 | 128 | 129 | TestProject\res\drawable-ldpi\ 130 | ic_launcher.png 131 | 1 132 | 133 | 134 | True 135 | 136 | 137 | TestProject\library\lib\armeabi-v7a\ 138 | libTestProject.so 139 | 1 140 | 141 | 142 | True 143 | True 144 | 145 | 146 | TestProject\res\drawable-hdpi\ 147 | ic_launcher.png 148 | 1 149 | 150 | 151 | True 152 | 153 | 154 | TestProject\library\lib\armeabi\ 155 | libTestProject.so 156 | 1 157 | 158 | 159 | True 160 | 161 | 162 | TestProject\library\lib\armeabi-v7a\ 163 | libTestProject.so 164 | 1 165 | 166 | 167 | True 168 | True 169 | 170 | 171 | TestProject\library\lib\x86\ 172 | libTestProject.so 173 | 1 174 | 175 | 176 | True 177 | 178 | 179 | TestProject\library\lib\armeabi-v7a\ 180 | gdbserver 181 | 1 182 | 183 | 184 | True 185 | 186 | 187 | TestProject\res\drawable-xhdpi\ 188 | ic_launcher.png 189 | 1 190 | 191 | 192 | True 193 | 194 | 195 | TestProject\res\drawable-xxhdpi\ 196 | ic_launcher.png 197 | 1 198 | 199 | 200 | True 201 | 202 | 203 | 204 | 205 | 206 | TestProject.app\Contents\MacOS\ 207 | libcgunwind.1.0.dylib 208 | 1 209 | 210 | 211 | True 212 | 213 | 214 | 215 | 216 | 217 | TestProject.app\ 218 | libcgunwind.1.0.dylib 219 | 1 220 | 221 | 222 | True 223 | 224 | 225 | 226 | -------------------------------------------------------------------------------- /Test/XE6/TestProject.dpr: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | program TestProject; 26 | 27 | uses 28 | {$IFDEF WIN32} 29 | // If used together with LeakCheck registering expected leaks may not bubble 30 | // to the internal system memory manager and thus may be reported to the user. 31 | // This behavior is due to FastMM not calling parent RegisterExpectedMemoryLeak 32 | // and is not LeakCheck issue. This is only exposed if LEAKCHECK_DEFER is 33 | // defined. 34 | {$IFDEF LEAKCHECK_DEFER} 35 | FastMM4, 36 | {$ENDIF} 37 | {$ENDIF } 38 | LeakCheck in '..\..\Source\LeakCheck.pas', 39 | System.StartUpCopy, 40 | LeakCheck.Utils in '..\..\Source\LeakCheck.Utils.pas', 41 | FMX.Forms, 42 | TestFramework in '..\..\External\DUnit\TestFramework.pas', 43 | TestInsight.DUnit, 44 | Posix.Proc in '..\..\External\Backtrace\Source\Posix.Proc.pas', 45 | LeakCheck.TestUnit in '..\LeakCheck.TestUnit.pas', 46 | LeakCheck.TestDUnit in '..\LeakCheck.TestDUnit.pas', 47 | LeakCheck.TestForm in '..\LeakCheck.TestForm.pas' {frmLeakCheckTest}, 48 | LeakCheck.DUnit in '..\..\Source\LeakCheck.DUnit.pas', 49 | LeakCheck.Cycle in '..\..\Source\LeakCheck.Cycle.pas', 50 | LeakCheck.TestCycle in '..\LeakCheck.TestCycle.pas', 51 | LeakCheck.DUnitCycle in '..\..\Source\LeakCheck.DUnitCycle.pas'; 52 | 53 | {$R *.res} 54 | 55 | begin 56 | ReportMemoryLeaksOnShutdown := True; 57 | 58 | // Simple test of functionality 59 | RunTests; 60 | 61 | // DUnit integration 62 | {$IFDEF WEAKREF} 63 | TLeakCheck.IgnoredLeakTypes := [tkUnknown]; 64 | {$ENDIF} 65 | MemLeakMonitorClass := TLeakCheckCycleMonitor; 66 | RunRegisteredTests; 67 | 68 | {$IFDEF GUI} 69 | // FMX Leak detection 70 | Application.Initialize; 71 | Application.CreateForm(TfrmLeakCheckTest, frmLeakCheckTest); 72 | Application.Run; 73 | {$ENDIF} 74 | end. 75 | 76 | -------------------------------------------------------------------------------- /Test/XE6/TestProject.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shadow-cs/delphi-leakcheck/67cc1bdfb670242b5b15d5942174c0024d7117b2/Test/XE6/TestProject.res -------------------------------------------------------------------------------- /Test/XE7/TestGroup.groupproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {E1F123A0-B05F-4E6A-A3F3-B8F3995F2B06} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | Default.Personality.12 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | -------------------------------------------------------------------------------- /Test/XE7/TestProject.deployproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 12 5 | 6 | 7 | 8 | TestProject\res\drawable-hdpi\ 9 | ic_launcher.png 10 | 1 11 | 12 | 13 | True 14 | 15 | 16 | TestProject\res\drawable-xlarge\ 17 | splash_image.png 18 | 1 19 | 20 | 21 | True 22 | 23 | 24 | TestProject\library\lib\armeabi-v7a\ 25 | libTestProject.so 26 | 1 27 | 28 | 29 | True 30 | True 31 | 32 | 33 | TestProject\res\drawable-large\ 34 | splash_image.png 35 | 1 36 | 37 | 38 | True 39 | 40 | 41 | TestProject\library\lib\armeabi\ 42 | libTestProject.so 43 | 1 44 | 45 | 46 | True 47 | 48 | 49 | TestProject\res\drawable-xxhdpi\ 50 | ic_launcher.png 51 | 1 52 | 53 | 54 | True 55 | 56 | 57 | TestProject\res\drawable-mdpi\ 58 | ic_launcher.png 59 | 1 60 | 61 | 62 | True 63 | 64 | 65 | TestProject\library\lib\mips\ 66 | libTestProject.so 67 | 1 68 | 69 | 70 | True 71 | 72 | 73 | TestProject\res\drawable\ 74 | splash_image_def.xml 75 | 1 76 | 77 | 78 | True 79 | 80 | 81 | TestProject\ 82 | AndroidManifest.xml 83 | 1 84 | 85 | 86 | True 87 | 88 | 89 | TestProject\res\drawable-small\ 90 | splash_image.png 91 | 1 92 | 93 | 94 | True 95 | 96 | 97 | TestProject\classes\ 98 | classes.dex 99 | 1 100 | 101 | 102 | True 103 | 104 | 105 | TestProject\res\values\ 106 | styles.xml 107 | 1 108 | 109 | 110 | True 111 | 112 | 113 | TestProject\res\drawable-xhdpi\ 114 | ic_launcher.png 115 | 1 116 | 117 | 118 | True 119 | 120 | 121 | TestProject\library\lib\armeabi-v7a\ 122 | gdbserver 123 | 1 124 | 125 | 126 | True 127 | 128 | 129 | TestProject\res\drawable-ldpi\ 130 | ic_launcher.png 131 | 1 132 | 133 | 134 | True 135 | 136 | 137 | TestProject\library\lib\x86\ 138 | libTestProject.so 139 | 1 140 | 141 | 142 | True 143 | 144 | 145 | TestProject\res\drawable-normal\ 146 | splash_image.png 147 | 1 148 | 149 | 150 | True 151 | 152 | 153 | TestProject\library\lib\armeabi-v7a\ 154 | gdbserver 155 | 1 156 | 157 | 158 | True 159 | 160 | 161 | 162 | 163 | 164 | TestProject\ 165 | TestProject.exe 166 | 0 167 | 168 | 169 | True 170 | True 171 | 172 | 173 | 174 | 175 | TestProject.app\Contents\MacOS\ 176 | libcgunwind.1.0.dylib 177 | 1 178 | 179 | 180 | True 181 | 182 | 183 | 184 | 185 | 186 | TestProject.app\ 187 | libcgunwind.1.0.dylib 188 | 1 189 | 190 | 191 | True 192 | 193 | 194 | 195 | -------------------------------------------------------------------------------- /Test/XE7/TestProject.dpr: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | program TestProject; 26 | 27 | uses 28 | {$IFDEF WIN32} 29 | // If used together with LeakCheck registering expected leaks may not bubble 30 | // to the internal system memory manager and thus may be reported to the user. 31 | // This behavior is due to FastMM not calling parent RegisterExpectedMemoryLeak 32 | // and is not LeakCheck issue. This is only exposed if LEAKCHECK_DEFER is 33 | // defined. 34 | {$IFDEF LEAKCHECK_DEFER} 35 | FastMM4, 36 | {$ENDIF} 37 | {$ENDIF } 38 | {$IFDEF MSWINDOWS} 39 | Windows, 40 | {$ENDIF } 41 | LeakCheck in '..\..\Source\LeakCheck.pas', 42 | {$IFDEF MSWINDOWS} 43 | LeakCheck.Setup.JclTrace, 44 | {$ELSE} 45 | LeakCheck.Setup.Trace, 46 | {$ENDIF} 47 | System.StartUpCopy, 48 | LeakCheck.Utils in '..\..\Source\LeakCheck.Utils.pas', 49 | FMX.Forms, 50 | TestFramework in '..\..\External\DUnit\TestFramework.pas', 51 | TestInsight.DUnit, 52 | Posix.Proc in '..\..\External\Backtrace\Source\Posix.Proc.pas', 53 | LeakCheck.TestUnit in '..\LeakCheck.TestUnit.pas', 54 | LeakCheck.TestDUnit in '..\LeakCheck.TestDUnit.pas', 55 | LeakCheck.TestForm in '..\LeakCheck.TestForm.pas' {frmLeakCheckTest}, 56 | LeakCheck.DUnit in '..\..\Source\LeakCheck.DUnit.pas', 57 | LeakCheck.Collections in '..\..\Source\LeakCheck.Collections.pas', 58 | LeakCheck.Cycle in '..\..\Source\LeakCheck.Cycle.pas', 59 | LeakCheck.Cycle.Utils in '..\..\Source\LeakCheck.Cycle.Utils.pas', 60 | LeakCheck.DUnitCycle in '..\..\Source\LeakCheck.DUnitCycle.pas', 61 | {$IFDEF MSWINDOWS} 62 | {$IFDEF CPUX32} 63 | LeakCheck.Trace.DbgHelp in '..\..\Source\LeakCheck.Trace.DbgHelp.pas', 64 | {$ENDIF } 65 | LeakCheck.Trace.WinApi in '..\..\Source\LeakCheck.Trace.WinApi.pas', 66 | LeakCheck.Trace.Jcl in '..\..\Source\LeakCheck.Trace.Jcl.pas', 67 | LeakCheck.MapFile in '..\..\Source\LeakCheck.MapFile.pas', 68 | LeakCheck.Trace.Map in '..\..\Source\LeakCheck.Trace.Map.pas', 69 | {$ENDIF } 70 | {$IFDEF POSIX} 71 | LeakCheck.Trace.Backtrace in '..\..\Source\LeakCheck.Trace.Backtrace.pas', 72 | {$ENDIF } 73 | LeakCheck.TestCycle in '..\LeakCheck.TestCycle.pas'; 74 | 75 | {$R *.res} 76 | 77 | begin 78 | ReportMemoryLeaksOnShutdown := True; 79 | 80 | {$IFDEF MSWINDOWS} 81 | TLeakCheck.GetStackTraceProc := WinApiStackTrace; 82 | //TLeakCheck.GetStackTraceProc := DbgHelpStackTrace; 83 | {$IFDEF CPUX64} 84 | TLeakCheck.GetStackTraceProc := JclFramesStackTrace; 85 | {$ELSE} 86 | TLeakCheck.GetStackTraceProc := JclRawStackTrace; 87 | {$ENDIF} 88 | //TLeakCheck.GetStackTraceProc := JclFramesStackTrace; 89 | 90 | TLeakCheck.GetStackTraceFormatterProc := JclStackTraceFormatter; 91 | //TLeakCheck.GetStackTraceFormatterProc := MapStackTraceFormatter; 92 | {$ENDIF} 93 | {$IFDEF POSIX} 94 | TLeakCheck.GetStackTraceProc := BacktraceStackTrace; 95 | TLeakCheck.GetStackTraceFormatterProc := PosixProcStackTraceFormatter; 96 | {$ENDIF} 97 | 98 | // Simple test of functionality 99 | RunTests; 100 | 101 | // DUnit integration 102 | {$IFDEF WEAKREF} 103 | TLeakCheck.IgnoredLeakTypes := [tkUnknown]; 104 | {$ENDIF} 105 | MemLeakMonitorClass := TLeakCheckCycleMonitor; 106 | RunRegisteredTests; 107 | 108 | {$IFDEF GUI} 109 | // FMX Leak detection 110 | Application.Initialize; 111 | Application.CreateForm(TfrmLeakCheckTest, frmLeakCheckTest); 112 | Application.Run; 113 | {$ENDIF} 114 | end. 115 | 116 | -------------------------------------------------------------------------------- /Test/XE7/TestProject.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shadow-cs/delphi-leakcheck/67cc1bdfb670242b5b15d5942174c0024d7117b2/Test/XE7/TestProject.res -------------------------------------------------------------------------------- /Test/XE7/TestProjectX.dpr: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { LeakCheck for Delphi } 4 | { } 5 | { Copyright (c) 2015 Honza Rames } 6 | { } 7 | { https://bitbucket.org/shadow_cs/delphi-leakcheck } 8 | { } 9 | {***************************************************************************} 10 | { } 11 | { Licensed under the Apache License, Version 2.0 (the "License"); } 12 | { you may not use this file except in compliance with the License. } 13 | { You may obtain a copy of the License at } 14 | { } 15 | { http://www.apache.org/licenses/LICENSE-2.0 } 16 | { } 17 | { Unless required by applicable law or agreed to in writing, software } 18 | { distributed under the License is distributed on an "AS IS" BASIS, } 19 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 20 | { See the License for the specific language governing permissions and } 21 | { limitations under the License. } 22 | { } 23 | {***************************************************************************} 24 | 25 | program TestProjectX; 26 | 27 | // Make sure to have DUnitX in your global search path or point DUNITX_DIR 28 | // environmental variable to DUnitX base source directory. 29 | 30 | // Note that in order to run this project you have to have the updated DUnitX 31 | // framework that supports extended leak checking. 32 | 33 | uses 34 | {$IFDEF WIN32} 35 | FastMM4, 36 | {$ENDIF } 37 | LeakCheck in '..\..\Source\LeakCheck.pas', 38 | System.StartUpCopy, 39 | LeakCheck.Utils in '..\..\Source\LeakCheck.Utils.pas', 40 | FMX.Forms, 41 | DUnitX.TestFramework, 42 | DUnitX.IoC, 43 | TestInsight.DUnitX, 44 | Posix.Proc in '..\..\External\Backtrace\Source\Posix.Proc.pas', 45 | LeakCheck.TestForm in '..\LeakCheck.TestForm.pas' {frmLeakCheckTest}, 46 | LeakCheck.TestDUnitX in '..\LeakCheck.TestDUnitX.pas', 47 | LeakCheck.Collections in '..\..\Source\LeakCheck.Collections.pas', 48 | LeakCheck.Cycle in '..\..\Source\LeakCheck.Cycle.pas', 49 | LeakCheck.Cycle.Utils in '..\..\Source\LeakCheck.Cycle.Utils.pas', 50 | DUnitX.MemoryLeakMonitor.LeakCheck in '..\..\External\DUnitX\DUnitX.MemoryLeakMonitor.LeakCheck.pas', 51 | DUnitX.MemoryLeakMonitor.LeakCheckCycle in '..\..\External\DUnitX\DUnitX.MemoryLeakMonitor.LeakCheckCycle.pas', 52 | {$IFDEF MSWINDOWS} 53 | {$IFDEF CPUX32} 54 | LeakCheck.Trace.DbgHelp in '..\..\Source\LeakCheck.Trace.DbgHelp.pas', 55 | {$ENDIF } 56 | LeakCheck.Trace.WinApi in '..\..\Source\LeakCheck.Trace.WinApi.pas', 57 | LeakCheck.Trace.Jcl in '..\..\Source\LeakCheck.Trace.Jcl.pas', 58 | LeakCheck.MapFile in '..\..\Source\LeakCheck.MapFile.pas', 59 | LeakCheck.Trace.Map in '..\..\Source\LeakCheck.Trace.Map.pas', 60 | {$ENDIF } 61 | {$IFDEF POSIX} 62 | LeakCheck.Trace.Backtrace in '..\..\Source\LeakCheck.Trace.Backtrace.pas', 63 | {$ENDIF } 64 | LeakCheck.TestCycle in '..\LeakCheck.TestCycle.pas'; 65 | 66 | {$R *.res} 67 | 68 | procedure Run; 69 | begin 70 | ReportMemoryLeaksOnShutdown := True; 71 | 72 | {$IFDEF MSWINDOWS} 73 | {$IFDEF CPUX64} 74 | TLeakCheck.GetStackTraceProc := WinApiStackTrace; 75 | {$ELSE} 76 | TLeakCheck.GetStackTraceProc := JclRawStackTrace; 77 | {$ENDIF} 78 | TLeakCheck.GetStackTraceFormatterProc := MapStackTraceFormatter; 79 | {$ENDIF} 80 | {$IFDEF POSIX} 81 | TLeakCheck.GetStackTraceProc := BacktraceStackTrace; 82 | TLeakCheck.GetStackTraceFormatterProc := PosixProcStackTraceFormatter; 83 | {$ENDIF} 84 | 85 | TDUnitX.RegisterTestFixture(TTestCycle); 86 | TDUnitX.RegisterTestFixture(TTestLeaksWithACycle); 87 | TDUnitX.RegisterTestFixture(TTestIgnoreGraphSimple); 88 | TDUnitX.RegisterTestFixture(TTestIgnoreGraphComplex); 89 | TDUnitXIoC.DefaultContainer.RegisterType( 90 | function : IMemoryLeakMonitor 91 | begin 92 | result := TDUnitXLeakCheckGraphMemoryLeakMonitor.Create; 93 | end); 94 | RunRegisteredTests; 95 | end; 96 | 97 | begin 98 | Run; 99 | end. 100 | -------------------------------------------------------------------------------- /Test/XE7/TestProjectX.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shadow-cs/delphi-leakcheck/67cc1bdfb670242b5b15d5942174c0024d7117b2/Test/XE7/TestProjectX.res -------------------------------------------------------------------------------- /Test/readme.txt: -------------------------------------------------------------------------------- 1 | Make sure to either add JCL sources to global search path or register JCL_DIR 2 | environmental variable pointing to JCL base `source` directory. 3 | --------------------------------------------------------------------------------