Thanks to visit codestin.com
Credit goes to github.com

Skip to content

Commit 4464ab6

Browse files
pyscripterpyscripter
committed
Removed support for Delphi 2010 and XE. This simplifies VarPyth.
1 parent 6038788 commit 4464ab6

File tree

2 files changed

+6
-297
lines changed

2 files changed

+6
-297
lines changed

‎Source/PythonEngine.pas

+2-2
Original file line numberDiff line numberDiff line change
@@ -62,8 +62,8 @@
6262
{ TODO -oMMM : implement Attribute descriptor and subclassing stuff }
6363

6464
{$IFNDEF FPC}
65-
{$IFNDEF DELPHI2010_OR_HIGHER}
66-
Error! Delphi 2010 or higher is required!
65+
{$IFNDEF DELPHIXE2_OR_HIGHER}
66+
Error! Delphi XE2 or higher is required!
6767
{$ENDIF}
6868
{$ENDIF}
6969

‎Source/VarPyth.pas

+4-295
Original file line numberDiff line numberDiff line change
@@ -150,14 +150,8 @@ TNamedParamDesc = record
150150
end;
151151
TNamedParamArray = array of TNamedParamDesc;
152152

153-
{$IFDEF DELPHIXE2_OR_HIGHER}
154-
{$DEFINE USESYSTEMDISPINVOKE} //Delphi 2010 DispInvoke is buggy
155-
{$IF defined(OSX64) or defined(LINUX) or not defined(DELPHI10_4_OR_HIGHER)}
156-
{$DEFINE PATCHEDSYSTEMDISPINVOKE} //To correct memory leaks
157-
{$IFEND}
158-
{$ENDIF}
159-
{$IF DEFINED(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20500)}
160-
{$DEFINE USESYSTEMDISPINVOKE}
153+
{$IF not defined(FPC) and (defined(OSX64) or defined(LINUX) or not defined(DELPHI10_4_OR_HIGHER))}
154+
{$DEFINE PATCHEDSYSTEMDISPINVOKE} //To correct memory leaks
161155
{$IFEND}
162156

163157
{ Python variant type handler }
@@ -173,20 +167,13 @@ TPythonVariantType = class(TInvokeableVariantType, IVarInstanceReference)
173167
const Arguments: TVarDataArray): PPyObject;
174168
function VarDataToPythonObject( AVarData : TVarData ) : PPyObject;
175169
procedure PyhonVarDataCreate( var Dest : TVarData; AObject : PPyObject );
176-
{$IFNDEF USESYSTEMDISPINVOKE}
177-
procedure DoDispInvoke(Dest: PVarData; var Source: TVarData;
178-
CallDesc: PCallDesc; Params: Pointer); virtual;
179-
function GetPropertyWithArg(var Dest: TVarData; const V: TVarData;
180-
const AName: AnsiString; AArg : TVarData): Boolean; virtual;
181-
{$ENDIF USESYSTEMDISPINVOKE}
182-
{$IFNDEF FPC}
183-
function FixupIdent(const AText: string): string; override;
184-
{$ENDIF FPC}
185170
{$IFDEF FPC}
186171
procedure VarDataClear(var Dest: TVarData);
187172
procedure VarDataCopyNoInd(var Dest: TVarData; const Source: TVarData);
188173
procedure VarDataCastTo(var Dest: TVarData; const Source: TVarData;
189174
const AVarType: TVarType); overload;
175+
{$ELSE}
176+
function FixupIdent(const AText: string): string; override;
190177
{$ENDIF FPC}
191178
public
192179
procedure Clear(var V: TVarData); override;
@@ -1158,7 +1145,6 @@ procedure TPythonVariantType.DispInvoke(Dest: PVarData;
11581145
procedure TPythonVariantType.DispInvoke(Dest: PVarData;
11591146
var Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
11601147
{$ENDIF}
1161-
{$IFDEF USESYSTEMDISPINVOKE}
11621148
{$IFDEF PATCHEDSYSTEMDISPINVOKE}
11631149
// Modified to correct memory leak QC102387 / RSP-23093
11641150
procedure PatchedFinalizeDispatchInvokeArgs(CallDesc: PCallDesc; const Args: TVarDataArray; OrderLTR : Boolean);
@@ -1336,283 +1322,6 @@ procedure TPythonVariantType.DispInvoke(Dest: PVarData;
13361322
end;
13371323
end;
13381324

1339-
{$ELSE USESYSTEMDISPINVOKE}
1340-
begin
1341-
DoDispInvoke(Dest, Source, CallDesc, Params);
1342-
end;
1343-
1344-
procedure TPythonVariantType.DoDispInvoke(Dest: PVarData;
1345-
var Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
1346-
type
1347-
PParamRec = ^TParamRec;
1348-
TParamRec = array[0..3] of Integer;
1349-
TStringDesc = record
1350-
BStr: WideString;
1351-
PStr: PAnsiString;
1352-
end;
1353-
var
1354-
LArguments: TVarDataArray;
1355-
LStrings: array of TStringDesc;
1356-
LStrCount: Integer;
1357-
LParamPtr: Pointer;
1358-
LNamedArgStart : Integer; //arg position of 1st named argument (if any)
1359-
LNamePtr: PAnsiChar;
1360-
1361-
procedure ParseParam(I: Integer);
1362-
const
1363-
CArgTypeMask = $7F;
1364-
CArgByRef = $80;
1365-
var
1366-
LArgType: Integer;
1367-
LArgByRef: Boolean;
1368-
begin
1369-
LArgType := CallDesc^.ArgTypes[I] and CArgTypeMask;
1370-
LArgByRef := (CallDesc^.ArgTypes[I] and CArgByRef) <> 0;
1371-
1372-
if I >= LNamedArgStart then
1373-
begin
1374-
LNamePtr := LNamePtr + Succ(StrLen(LNamePtr));
1375-
fNamedParams[I-LNamedArgStart].Index := I;
1376-
fNamedParams[I-LNamedArgStart].Name := AnsiString(LNamePtr);
1377-
end;
1378-
1379-
// error is an easy expansion
1380-
if LArgType = varError then
1381-
SetClearVarToEmptyParam(LArguments[I])
1382-
1383-
// literal string
1384-
else if LArgType = varStrArg then
1385-
begin
1386-
with LStrings[LStrCount] do
1387-
if LArgByRef then
1388-
begin
1389-
//BStr := StringToOleStr(PAnsiString(ParamPtr^)^);
1390-
BStr := WideString(System.Copy(PAnsiString(LParamPtr^)^, 1, MaxInt));
1391-
PStr := PAnsiString(LParamPtr^);
1392-
LArguments[I].VType := varOleStr or varByRef;
1393-
LArguments[I].VOleStr := @BStr;
1394-
end
1395-
else
1396-
begin
1397-
//BStr := StringToOleStr(PAnsiString(LParamPtr)^);
1398-
BStr := WideString(System.Copy(PAnsiString(LParamPtr)^, 1, MaxInt));
1399-
PStr := nil;
1400-
LArguments[I].VType := varOleStr;
1401-
if BStr = '' then
1402-
LArguments[I].VOleStr := nil
1403-
else
1404-
LArguments[I].VOleStr := PWideChar(BStr);
1405-
end;
1406-
Inc(LStrCount);
1407-
end
1408-
1409-
// value is by ref
1410-
else if LArgByRef then
1411-
begin
1412-
if (LArgType = varVariant) and
1413-
(PVarData(LParamPtr^)^.VType = varString)
1414-
or (PVarData(LParamPtr)^.VType = varUString)
1415-
then
1416-
//VarCast(PVariant(ParamPtr^)^, PVariant(ParamPtr^)^, varOleStr);
1417-
VarDataCastTo(PVarData(LParamPtr^)^, PVarData(LParamPtr^)^, varOleStr);
1418-
LArguments[I].VType := LArgType or varByRef;
1419-
LArguments[I].VPointer := Pointer(LParamPtr^);
1420-
end
1421-
1422-
// value is a variant
1423-
else if LArgType = varVariant then
1424-
if (PVarData(LParamPtr)^.VType = varString)
1425-
or (PVarData(LParamPtr)^.VType = varUString)
1426-
then
1427-
begin
1428-
with LStrings[LStrCount] do
1429-
begin
1430-
//BStr := StringToOleStr(AnsiString(PVarData(LParamPtr)^.VString));
1431-
if (PVarData(LParamPtr)^.VType = varString) then
1432-
BStr := WideString(System.Copy(AnsiString(PVarData(LParamPtr)^.VString), 1, MaxInt))
1433-
else
1434-
{$IFDEF FPC}
1435-
BStr := System.Copy(UnicodeString(PVarData(LParamPtr)^.VString), 1, MaxInt);
1436-
{$ELSE}
1437-
BStr := System.Copy(UnicodeString(PVarData(LParamPtr)^.VUString), 1, MaxInt);
1438-
{$ENDIF}
1439-
PStr := nil;
1440-
LArguments[I].VType := varOleStr;
1441-
LArguments[I].VOleStr := PWideChar(BStr);
1442-
end;
1443-
Inc(LStrCount);
1444-
Inc(NativeInt(LParamPtr), SizeOf(TVarData) - SizeOf(Pointer));
1445-
end
1446-
else
1447-
begin
1448-
LArguments[I] := PVarData(LParamPtr)^;
1449-
Inc(NativeInt(LParamPtr), SizeOf(TVarData) - SizeOf(Pointer));
1450-
end
1451-
else
1452-
begin
1453-
LArguments[I].VType := LArgType;
1454-
case CVarTypeToElementInfo[LArgType].Size of
1455-
1, 2, 4:
1456-
begin
1457-
LArguments[I].VLongs[1] := PParamRec(LParamPtr)^[0];
1458-
end;
1459-
8:
1460-
begin
1461-
LArguments[I].VLongs[1] := PParamRec(LParamPtr)^[0];
1462-
LArguments[I].VLongs[2] := PParamRec(LParamPtr)^[1];
1463-
Inc(NativeInt(LParamPtr), 8 - SizeOf(Pointer));
1464-
end;
1465-
else
1466-
RaiseDispError;
1467-
end;
1468-
end;
1469-
Inc(NativeInt(LParamPtr), SizeOf(Pointer));
1470-
end;
1471-
1472-
var
1473-
I, LArgCount: Integer;
1474-
LIdent: AnsiString;
1475-
LTemp: TVarData;
1476-
begin
1477-
//------------------------------------------------------------------------------------
1478-
// Note that this method is mostly a copy&paste from TInvokeableVariantType.DispInvoke
1479-
// because Borland assumes that the names are not case sensitive, whereas Python has
1480-
// case sensitive symbols.
1481-
// We modified the property get to allow the use of indexed properties.
1482-
//------------------------------------------------------------------------------------
1483-
1484-
// Grab the identifier
1485-
LArgCount := CallDesc^.ArgCount;
1486-
//After arg types, method name and named arg names are stored
1487-
//Position pointer on method name
1488-
LNamePtr := PAnsiChar(@CallDesc^.ArgTypes[LArgCount]);
1489-
LIdent := AnsiString(LNamePtr);
1490-
//Named params must be after positional params
1491-
LNamedArgStart := CallDesc^.ArgCount - CallDesc^.NamedArgCount;
1492-
SetLength(fNamedParams, CallDesc^.NamedArgCount);
1493-
1494-
// Parse the arguments
1495-
LParamPtr := Params;
1496-
SetLength(LArguments, LArgCount);
1497-
LStrCount := 0;
1498-
SetLength(LStrings, LArgCount);
1499-
for I := 0 to LArgCount - 1 do
1500-
ParseParam(I);
1501-
1502-
// What type of invoke is this?
1503-
case CallDesc^.CallType of
1504-
CDoMethod:
1505-
// procedure with N arguments
1506-
if Dest = nil then
1507-
begin
1508-
if not DoProcedure(Source, string(LIdent), LArguments) then
1509-
begin
1510-
1511-
// ok maybe its a function but first we must make room for a result
1512-
VarDataInit(LTemp);
1513-
try
1514-
1515-
// notate that the destination shouldn't be bothered with
1516-
// functions can still return stuff, we just do this so they
1517-
// can tell that they don't need to if they don't want to
1518-
SetClearVarToEmptyParam(LTemp);
1519-
1520-
// ok lets try for that function
1521-
if not DoFunction(LTemp, Source, string(LIdent), LArguments) then
1522-
RaiseDispError;
1523-
finally
1524-
VarDataClear(LTemp);
1525-
end;
1526-
end
1527-
end
1528-
1529-
// property get or function with 0 argument
1530-
else if LArgCount = 0 then
1531-
begin
1532-
if not GetProperty(Dest^, Source, string(LIdent)) and
1533-
not DoFunction(Dest^, Source, string(LIdent), LArguments) then
1534-
RaiseDispError;
1535-
end
1536-
1537-
// function with N arguments
1538-
else if not DoFunction(Dest^, Source, string(LIdent), LArguments) then
1539-
RaiseDispError;
1540-
1541-
CPropertyGet:
1542-
begin
1543-
// here that code has been changed to allow the indexed properties.
1544-
1545-
if Dest = nil then // there must be a dest
1546-
RaiseDispError;
1547-
if LArgCount = 0 then // no args
1548-
begin
1549-
if not GetProperty(Dest^, Source, string(LIdent)) then // get op be valid
1550-
RaiseDispError;
1551-
end
1552-
else if LArgCount = 1 then // only one arg
1553-
begin
1554-
if not GetPropertyWithArg(Dest^, Source, LIdent, LArguments[0]) then // get op be valid
1555-
RaiseDispError;
1556-
end
1557-
else
1558-
raise Exception.Create( SMultiDimensionalPropsNotSupported );
1559-
end;
1560-
1561-
CPropertySet:
1562-
if not ((Dest = nil) and // there can't be a dest
1563-
(LArgCount = 1) and // can only be one arg
1564-
SetProperty(Source, string(LIdent), LArguments[0])) then // set op be valid
1565-
RaiseDispError;
1566-
else
1567-
RaiseDispError;
1568-
end;
1569-
1570-
// copy back the string info
1571-
I := LStrCount;
1572-
while I <> 0 do
1573-
begin
1574-
Dec(I);
1575-
with LStrings[I] do
1576-
if Assigned(PStr) then
1577-
PStr^ := AnsiString(System.Copy(BStr, 1, MaxInt));
1578-
end;
1579-
end;
1580-
1581-
function TPythonVariantType.GetPropertyWithArg(var Dest: TVarData;
1582-
const V: TVarData; const AName: AnsiString; AArg: TVarData): Boolean;
1583-
var
1584-
_prop, _result : PPyObject;
1585-
begin
1586-
with GetPythonEngine do
1587-
begin
1588-
_result := nil;
1589-
_prop := PyObject_GetAttrString(TPythonVarData(V).VPython.PyObject, PAnsiChar(AName));
1590-
CheckError;
1591-
if Assigned(_prop) then
1592-
begin
1593-
// here we check only sequences, as Delphi does not allow a type different from Integer
1594-
// to be used within brackets.
1595-
// But you can still access a dictionary with parenthesis, like: myObj.MyDict('MyKey')
1596-
// Note that we can't use the brackets on a Python variant that contains a list,
1597-
// because Delphi thinks it's a variant array, whereas it is not, of course!
1598-
// So: myList[0] won't work, but myObj.MyList[0] will!!!
1599-
if PySequence_Check(_prop) <> 0 then
1600-
begin
1601-
_result := PySequence_GetItem(_prop, Variant(AArg));
1602-
CheckError;
1603-
end; // of if
1604-
end; // of if
1605-
Result := Assigned(_result);
1606-
if Result then
1607-
try
1608-
PyhonVarDataCreate(Dest, _result);
1609-
finally
1610-
Py_XDecRef(_prop);
1611-
end; // of try
1612-
end; // of with
1613-
end;
1614-
{$ENDIF USESYSTEMDISPINVOKE}
1615-
16161325
function TPythonVariantType.DoFunction(var Dest: TVarData;
16171326
const V: TVarData; const AName: string;
16181327
const Arguments: TVarDataArray): Boolean;

0 commit comments

Comments
 (0)