* fix #39907: only load system class types from units that are marked as a System unit

+ added test
This commit is contained in:
Sven/Sarah Barth 2022-09-18 12:03:48 +02:00
parent 7b09eee02a
commit c8fee69345
3 changed files with 76 additions and 37 deletions

View File

@ -7772,6 +7772,12 @@ implementation
{ handles the predefined class tobject }
{ the last TOBJECT which is loaded gets }
{ it ! }
{ but do this only from a unit that's }
{ marked as system unit to avoid some }
{ equally named user's type to override }
{ the internal types! }
if mf_system_unit in current_module.moduleflags then
begin
if (childof=nil) and
(objecttype in [odt_class,odt_javaclass]) and
(objname^='TOBJECT') then
@ -7811,6 +7817,8 @@ implementation
else if (objname^='FPCBASEPROCVARTYPE') then
java_procvarbase:=self;
end;
end;
writing_class_record_dbginfo:=false;
end;

18
tests/webtbs/tw39907.pp Normal file
View File

@ -0,0 +1,18 @@
{ %NORUN }
{ %RECOMPILE }
{$mode objfpc}
{$modeswitch functionreferences}
program tw39907;
uses
uw39907;
var
obj: TObject;
proc: reference to procedure;
begin
obj := TObject.Create;
proc := @obj.Free;
end.

13
tests/webtbs/uw39907.pp Normal file
View File

@ -0,0 +1,13 @@
{$mode objfpc}
unit uw39907;
interface
type
TObject = class
end;
implementation
end.