Browse Source

* Implement DropContext/KeepContext for Delphi compatibility. Patch by Artem Izmaylov. Fixes issue #40884

Michaël Van Canneyt 1 year ago
parent
commit
92f937c40e
1 changed files with 16 additions and 0 deletions
  1. 16 0
      packages/rtl-objpas/src/inc/rtti.pp

+ 16 - 0
packages/rtl-objpas/src/inc/rtti.pp

@@ -294,6 +294,8 @@ type
   { TRttiContext }
 
   TRttiContext = record
+  strict private
+    class var FKeptContexts: array[Boolean] of IUnknown;
   Public
     UsePublishedOnly : Boolean;
   private
@@ -303,6 +305,8 @@ type
   public
     class function Create: TRttiContext; static;
     class function Create(aUsePublishedOnly : Boolean): TRttiContext; static;
+    class procedure DropContext; static;
+    class procedure KeepContext; static;
     procedure  Free;
     function GetType(ATypeInfo: PTypeInfo): TRttiType;
     function GetType(AClass: TClass): TRttiType;
@@ -6918,6 +6922,18 @@ begin
   Result.UsePublishedOnly:=aUsePublishedOnly;
 end;
 
+class procedure TRttiContext.DropContext;
+begin
+  FKeptContexts[False] := nil;
+  FKeptContexts[True] := nil;
+end;
+
+class procedure TRttiContext.KeepContext;
+begin
+  FKeptContexts[False] := TPoolToken.Create(False);
+  FKeptContexts[True] := TPoolToken.Create(True);
+end;
+
 procedure TRttiContext.Free;
 begin
   FContextToken := nil;