Skip to content

Commit c93d3d8

Browse files
author
pyscripter
committed
Workaround for memory leak in XE2
1 parent 46145cb commit c93d3d8

File tree

5 files changed

+112
-1
lines changed

5 files changed

+112
-1
lines changed

‎PythonForDelphi/Components/Sources/Core/Definition.Inc

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -172,6 +172,7 @@
172172
{$DEFINE DELPHI2010_OR_HIGHER}
173173
{$ENDIF}
174174
{$IFDEF VER220} // Delphi XE
175+
{$DEFINE DELPHIXE}
175176
{$DEFINE DELPHI2010}
176177
{$DEFINE DELPHI4_OR_HIGHER}
177178
{$DEFINE DELPHI5_OR_HIGHER}
@@ -186,6 +187,8 @@
186187
{$DEFINE DELPHIXE_OR_HIGHER}
187188
{$ENDIF}
188189
{$IFDEF VER230} // Delphi XE2
190+
{$DEFINE DELPHIXE2}
191+
{$DEFINE DELPHIXE}
189192
{$DEFINE DELPHI2010}
190193
{$DEFINE DELPHI4_OR_HIGHER}
191194
{$DEFINE DELPHI5_OR_HIGHER}

‎PythonForDelphi/Components/Sources/Core/VarPyth.pas

Lines changed: 104 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -927,6 +927,102 @@ procedure SetClearVarToEmptyParam(var V: TVarData);
927927
{$IFDEF USESYSTEMDISPINVOKE}
928928
procedure TPythonVariantType.DispInvoke(Dest: PVarData;
929929
const Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
930+
{$IFDEF DELPHIXE2}
931+
// Modified to correct memory leak QC102387
932+
procedure PatchedDispInvoke(Dest: PVarData;
933+
const Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
934+
type
935+
PParamRec = ^TParamRec;
936+
TParamRec = array[0..3] of LongInt;
937+
TStringDesc = record
938+
BStr: WideString;
939+
PStr: PAnsiString;
940+
end;
941+
const
942+
CDoMethod = $01;
943+
CPropertyGet = $02;
944+
CPropertySet = $04;
945+
var
946+
I, LArgCount: Integer;
947+
LIdent: string;
948+
LTemp: TVarData;
949+
VarParams : TVarDataArray;
950+
Strings: TStringRefList;
951+
begin
952+
// Grab the identifier
953+
LArgCount := CallDesc^.ArgCount;
954+
LIdent := FixupIdent(AnsiString(PAnsiChar(@CallDesc^.ArgTypes[LArgCount])));
955+
956+
FillChar(Strings, SizeOf(Strings), 0);
957+
VarParams := GetDispatchInvokeArgs(CallDesc, Params, Strings, true);
958+
959+
// What type of invoke is this?
960+
case CallDesc^.CallType of
961+
CDoMethod:
962+
// procedure with N arguments
963+
if Dest = nil then
964+
begin
965+
if not DoProcedure(Source, LIdent, VarParams) then
966+
begin
967+
968+
// ok maybe its a function but first we must make room for a result
969+
VarDataInit(LTemp);
970+
try
971+
972+
// notate that the destination shouldn't be bothered with
973+
// functions can still return stuff, we just do this so they
974+
// can tell that they don't need to if they don't want to
975+
SetClearVarToEmptyParam(LTemp);
976+
977+
// ok lets try for that function
978+
if not DoFunction(LTemp, Source, LIdent, VarParams) then
979+
RaiseDispError;
980+
finally
981+
VarDataClear(LTemp);
982+
end;
983+
end
984+
end
985+
986+
// property get or function with 0 argument
987+
else if LArgCount = 0 then
988+
begin
989+
if not GetProperty(Dest^, Source, LIdent) and
990+
not DoFunction(Dest^, Source, LIdent, VarParams) then
991+
RaiseDispError;
992+
end
993+
994+
// function with N arguments
995+
else if not DoFunction(Dest^, Source, LIdent, VarParams) then
996+
RaiseDispError;
997+
998+
CPropertyGet:
999+
if not ((Dest <> nil) and // there must be a dest
1000+
(LArgCount = 0) and // only no args
1001+
GetProperty(Dest^, Source, LIdent)) then // get op be valid
1002+
RaiseDispError;
1003+
1004+
CPropertySet:
1005+
if not ((Dest = nil) and // there can't be a dest
1006+
(LArgCount = 1) and // can only be one arg
1007+
SetProperty(Source, LIdent, VarParams[0])) then // set op be valid
1008+
RaiseDispError;
1009+
else
1010+
RaiseDispError;
1011+
end;
1012+
1013+
for I := 0 to Length(Strings) - 1 do
1014+
begin
1015+
if Pointer(Strings[I].Wide) = nil then
1016+
Break;
1017+
if Strings[I].Ansi <> nil then
1018+
Strings[I].Ansi^ := AnsiString(Strings[I].Wide)
1019+
else if Strings[I].Unicode <> nil then
1020+
Strings[I].Unicode^ := UnicodeString(Strings[I].Wide)
1021+
end;
1022+
for I := Low(VarParams) to High(VarParams) do
1023+
VarDataClear(VarParams[I]);
1024+
end;
1025+
{$ENDIF DELPHIXE2}
9301026

9311027
procedure GetNamedParams;
9321028
var
@@ -953,9 +1049,17 @@ procedure TPythonVariantType.DispInvoke(Dest: PVarData;
9531049
if (CallDesc^.CallType = CPropertyGet) and (CallDesc^.ArgCount = 1) then begin
9541050
NewCallDesc := CallDesc^;
9551051
NewCallDesc.CallType := CDoMethod;
1052+
{$IFDEF DELPHIXE2}
1053+
PatchedDispInvoke(Dest, Source, @NewCallDesc, Params);
1054+
{$ELSE DELPHIXE2}
9561055
inherited DispInvoke(Dest, Source, @NewCallDesc, Params);
1056+
{$ENDIF DELPHIXE2}
9571057
end else
1058+
{$IFDEF DELPHIXE2}
1059+
PatchedDispInvoke(Dest, Source, CallDesc, Params);
1060+
{$ELSE DELPHIXE2}
9581061
inherited;
1062+
{$ENDIF DELPHIXE2}
9591063
finally
9601064
if CallDesc^.NamedArgCount > 0 then SetLength(fNamedParams, 0);
9611065
end;

‎PythonForDelphi/Demos/Demo25/VarPythUnitTest.dpr

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,6 @@
1+
// JCL_DEBUG_EXPERT_GENERATEJDBG OFF
2+
// JCL_DEBUG_EXPERT_INSERTJDBG OFF
3+
// JCL_DEBUG_EXPERT_DELETEMAPFILE OFF
14
program VarPythUnitTest;
25

36
uses
@@ -12,6 +15,7 @@ uses
1215
{$R *.res}
1316

1417
begin
18+
ReportMemoryLeaksOnShutdown := True;
1519
Application.Initialize;
1620
Application.CreateForm(TMain, Main);
1721
Application.Run;

‎PythonForDelphi/Demos/Demo25/VarPythUnitTest.dproj

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
<ProjectVersion>13.4</ProjectVersion>
88
<FrameworkType>VCL</FrameworkType>
99
<Base>True</Base>
10-
<Platform Condition="'$(Platform)'==''">Win32</Platform>
10+
<Platform Condition="'$(Platform)'==''">Win64</Platform>
1111
<TargetedPlatforms>3</TargetedPlatforms>
1212
<AppType>Application</AppType>
1313
</PropertyGroup>

‎PythonForDelphi/Demos/Demo25/VarPythUnitTest.res

1.07 KB
Binary file not shown.

0 commit comments

Comments
 (0)