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

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

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-08-09 10:46:18 +02:00
parent c53e1b20d7
commit 92f937c40e
1 changed files with 16 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
packages/rtl-objpas/src/inc/rtti.pp
View File

@ -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;