Skip to content

Instantly share code, notes, and snippets.

@obones
Created November 20, 2018 16:27
Show Gist options
  • Save obones/abbe67b58526d6decb425de202b37aef to your computer and use it in GitHub Desktop.
Save obones/abbe67b58526d6decb425de202b37aef to your computer and use it in GitHub Desktop.
For issue in FastMM
program FinalizeWeak;
{$APPTYPE CONSOLE}
{$R *.res}
uses
FastMM4,
System.SysUtils,
Unit1 in 'Unit1.pas';
begin
ReportMemoryLeaksOnShutdown := True;
try
GetGlobalParent;
{$MESSAGE HINT 'This does not help'}
// DestroyGlobalParent;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<Base>True</Base>
<AppType>Console</AppType>
<Config Condition="'$(Config)'==''">Debug</Config>
<FrameworkType>None</FrameworkType>
<MainSource>FinalizeWeak.dpr</MainSource>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<ProjectGuid>{6265017D-CA54-4631-8F14-234E30302590}</ProjectGuid>
<ProjectVersion>18.4</ProjectVersion>
<TargetedPlatforms>1</TargetedPlatforms>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<SanitizedProjectName>FinalizeWeak</SanitizedProjectName>
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
<DCC_UnitSearchPath>FastMM;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<DCC_UsePackage>RESTComponents;RemObjects_Server_Indy_D25;FireDACIBDriver;RemObjects_Indy_D25;FireDACCommon;RESTBackendComponents;soapserver;CloudService;FireDACCommonDriver;inet;FireDAC;FireDACSqliteDriver;soaprtl;soapmidas;$(DCC_UsePackage)</DCC_UsePackage>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1036</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<BT_BuildType>Debug</BT_BuildType>
<DCC_ConsoleTarget>true</DCC_ConsoleTarget>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<DCC_UsePackage>DBXSqliteDriver;dxCoreRS25;dxSpreadSheetCoreDialogsRS25;DBXInterBaseDriver;vclactnband;vclFireDAC;cxExportRS25;RemObjects_Server_Synapse_D25;tethering;svnui;FireDACADSDriver;vcltouch;vcldb;bindcompfmx;svn;unidac250;inetdb;cxLibraryRS25;dxOfficeCoreRS25;fmx;fmxdae;dbexpress;IndyCore;Tee925;vclx;dsnap;RemObjects_Synapse_D25;TeeWorld925;Hydra_Core_D25;Hydra_VCL_D25;VCLRESTComponents;cxPageControlRS25;cxPivotGridRS25;vclie;bindengine;DBXMySQLDriver;FireDACMySQLDriver;FireDACCommonODBC;bindcompdbx;IndyIPCommon;Addactis_RTokyo;vcl;IndyIPServer;PngComponents;IndySystem;TeeUI925;dac250;dsnapcon;madExcept_;VirtualTreesR;dxLayoutControlRS25;FireDACMSAccDriver;fmxFireDAC;vclimg;madBasic_;dxSpreadSheetCoreRS25;dxServerModeRS25;dxSpreadSheetRS25;TeeGL925;FireDACPgDriver;TeePro925;cxEditorsRS25;cxGridRS25;DbxCommonDriver;xmlrtl;fmxobj;vclwinx;rtl;cxDataRS25;DbxClientDriver;dacvcl250;madDisAsm_;CustomIPTransport;vcldsnap;dxmdsRS25;bindcomp;appanalytics;IndyIPClient;bindcompvcl;SynEdit_R;dxGDIPlusRS25;dxThemeRS25;dbxcds;VclSmp;unidacvcl250;adortl;TeeImage925;TeeLanguage925;dsnapxml;dbrtl;inetdbxpress;IndyProtocols;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_DebugDCUs>true</DCC_DebugDCUs>
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_Optimize>false</DCC_Optimize>
<DCC_RemoteDebug>true</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<DCC_RemoteDebug>false</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="Unit1.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType>Application</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">FinalizeWeak.dpr</Source>
</Source>
<Excluded_Packages/>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="Win32\Debug\FinalizeWeak.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>FinalizeWeak.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="Win32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DebugSymbols">
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyFramework">
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyModule">
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="DependencyPackage">
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Name="File">
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="ProjectOutput">
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectUWPManifest">
<Platform Name="Win32">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo150">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo44">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
</Deployment>
<Platforms>
<Platform value="Android">False</Platform>
<Platform value="OSX32">False</Platform>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
<Platform value="iOSDevice32">False</Platform>
<Platform value="iOSDevice64">False</Platform>
<Platform value="iOSSimulator">False</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
</Project>
unit Unit1;
interface
type
IChild = interface;
IParent = interface
function GetChild: IChild;
property Child: IChild read GetChild;
end;
IChild = interface
function GetCaption: string;
function GetParent: IParent;
property Caption: string read GetCaption;
property Parent: IParent read GetParent;
end;
function GetGlobalParent: IParent;
procedure DestroyGlobalParent;
implementation
type
TParentImpl = class(TInterfacedObject, IParent)
private
class var FInstance: IParent;
class function GetInstance: IParent;
private
FChild: IChild;
protected
// IParent
function GetChild: IChild;
public
constructor Create;
end;
TChildImpl = class(TInterfacedObject, IChild)
private
{$MESSAGE HINT 'This attribute triggers the crash. Remove it and you get a leak, as expected'}
[Weak]
FParent: IParent;
FCaption: string;
protected
// IChild
function GetCaption: string;
function GetParent: IParent;
public
constructor Create(const AParent: IParent; const ACaption: string);
end;
function GetGlobalParent: IParent;
begin
Result := TParentImpl.GetInstance;
end;
procedure DestroyGlobalParent;
begin
TParentImpl.FInstance := nil;
end;
{ TParentImpl }
class function TParentImpl.GetInstance: IParent;
begin
if not Assigned(FInstance) then
FInstance := TParentImpl.Create;
Result := FInstance;
end;
function TParentImpl.GetChild: IChild;
begin
Result := FChild;
end;
constructor TParentImpl.Create;
begin
inherited Create;
FChild := TChildImpl.Create(Self, 'Test');
end;
{ TChildImpl }
constructor TChildImpl.Create(const AParent: IParent; const ACaption: string);
begin
inherited Create;
FCaption := ACaption;
FParent := AParent;
end;
function TChildImpl.GetCaption: string;
begin
Result := FCaption;
end;
function TChildImpl.GetParent: IParent;
begin
Result := FParent;
end;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment