paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 14:49:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* move check for argument/result indirection to separate function

Browse Source 
git-svn-id: trunk@42067 -
This commit is contained in:
svenbarth 2019-05-15 05:28:42 +00:00
parent ea270d9800
commit 5516bcb266
1 changed files with 11 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
packages/libffi/src/ffi.manager.pp
View File

@ -280,7 +280,7 @@ begin
Result := @ffi_type_pointer; Result := @ffi_type_pointer;
end; end;
function ValueToFFIValue(constref aValue: Pointer; aKind: TTypeKind; aFlags: TParamFlags; aIsResult: Boolean): Pointer; function ArgIsIndirect(aKind: TTypeKind; aFlags: TParamFlags; aIsResult: Boolean): Boolean;
const const
ResultTypeNeedsIndirection = [ ResultTypeNeedsIndirection = [
tkAString, tkAString,
@ -290,12 +290,20 @@ const
tkDynArray tkDynArray
]; ];
begin begin
Result := aValue; Result := False;
if (aKind = tkSString) or if (aKind = tkSString) or
(aIsResult and (aKind in ResultTypeNeedsIndirection)) or (aIsResult and (aKind in ResultTypeNeedsIndirection)) or
(aFlags * [pfArray, pfOut, pfVar, pfConstRef] <> []) or (aFlags * [pfArray, pfOut, pfVar, pfConstRef] <> []) or
((aKind = tkUnknown) and (pfConst in aFlags)) then ((aKind = tkUnknown) and (pfConst in aFlags)) then
Result := @aValue; Result := True;
end;
function ValueToFFIValue(constref aValue: Pointer; aKind: TTypeKind; aFlags: TParamFlags; aIsResult: Boolean): Pointer;
begin
if ArgIsIndirect(aKind, aFlags, aIsResult) then
Result := @aValue
else
Result := aValue;
end; end;
procedure FFIValueToValue(Source, Dest: Pointer; TypeInfo: PTypeInfo); procedure FFIValueToValue(Source, Dest: Pointer; TypeInfo: PTypeInfo);