mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 12:49:09 +02:00
* fix #39907: only load system class types from units that are marked as a System unit
+ added test
This commit is contained in:
parent
7b09eee02a
commit
c8fee69345
@ -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
18
tests/webtbs/tw39907.pp
Normal 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
13
tests/webtbs/uw39907.pp
Normal file
@ -0,0 +1,13 @@
|
||||
{$mode objfpc}
|
||||
|
||||
unit uw39907;
|
||||
interface
|
||||
|
||||
type
|
||||
TObject = class
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user