Parcourir la source

rtl: initial Rtti.Invoke(), issue 34710

mattias il y a 6 ans
Parent
commit
5791ba170e
2 fichiers modifiés avec 30 ajouts et 1 suppressions
  1. 24 1
      packages/rtl/rtti.pas
  2. 6 0
      packages/rtl/typinfo.pas

+ 24 - 1
packages/rtl/rtti.pas

@@ -17,9 +17,18 @@ unit RTTI;
 interface
 
 uses
-  SysUtils, Types;
+  SysUtils, Types, TypInfo, JS;
+
+resourcestring
+  SErrInvokeInvalidCodeAddr = 'CodeAddress is not a function';
 
 type
+  // will be changed to 'record' and improved as soon as the
+  // operator overloading is implemented
+  TValue = JSValue;
+
+  EInvoke = EJS;
+
   TVirtualInterfaceInvokeEvent = function(const aMethodName: string;
     const Args: TJSValueDynArray): JSValue of object;
 
@@ -38,6 +47,10 @@ type
 procedure CreateVirtualCorbaInterface(InterfaceTypeInfo: Pointer;
   const MethodImplementation: TVirtualInterfaceInvokeEvent; out IntfVar); assembler;
 
+function Invoke(ACodeAddress: Pointer; const AArgs: TJSValueDynArray;
+  ACallConv: TCallConv; AResultType: PTypeInfo; AIsStatic: Boolean;
+  AIsConstructor: Boolean): TValue;
+
 implementation
 
 procedure CreateVirtualCorbaInterface(InterfaceTypeInfo: Pointer;
@@ -103,5 +116,15 @@ begin
   OnInvoke:=InvokeEvent;
 end;
 
+function Invoke(ACodeAddress: Pointer; const AArgs: TJSValueDynArray;
+  ACallConv: TCallConv; AResultType: PTypeInfo; AIsStatic: Boolean;
+  AIsConstructor: Boolean): TValue;
+begin
+  if isFunction(ACodeAddress) then
+    Result := TJSFunction(ACodeAddress).apply(nil, AArgs)
+  else
+    raise EInvoke.Create(SErrInvokeInvalidCodeAddr);
+end;
+
 end.
 

+ 6 - 0
packages/rtl/typinfo.pas

@@ -56,6 +56,10 @@ type
     );
   TTypeKinds = set of TTypeKind;
 
+  // for compatibility with Delphi/FPC, ignored under pas2js
+  TCallConv = (ccReg, ccCdecl, ccPascal, ccStdCall, ccSafeCall, ccCppdecl,
+    ccFar16, ccOldFPCCall, ccInternProc, ccSysCall, ccSoftFloat, ccMWPascal);
+
 const
   tkFloat = tkDouble; // for compatibility with Delphi/FPC
   tkProcedure = tkProcVar; // for compatibility with Delphi
@@ -73,6 +77,8 @@ type
   end;
   TTypeInfoClassOf = class of TTypeInfo;
 
+  PTypeInfo = Pointer; // for compatibility with Delphi/FPC, under pas2js it is a TTypeInfo
+
   TOrdType  = (
     otSByte,      // 0
     otUByte,      // 1