paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 21:29:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ extend tobjectdef with the possiblity to create it as unregistered

Browse Source 
* for now all objectdefs are created as registered
Note: an additional parameter instead of an overload is used for tobjectdef.create as otherwise both constructors would need to be overridden in potential descendant CPU-specific classes...

git-svn-id: trunk@31592 -
This commit is contained in:
svenbarth 2015-09-11 13:28:49 +00:00
parent d45c275ef3
commit 84b9d9839c
4 changed files with 14 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/pdecobj.pas
View File

@ -1330,7 +1330,7 @@ implementation
begin begin
Message(parser_e_forward_mismatch); Message(parser_e_forward_mismatch);
{ recover } { recover }
current_structdef:=cobjectdef.create(current_objectdef.objecttype,n,nil); current_structdef:=cobjectdef.create(current_objectdef.objecttype,n,nil,true);
include(current_structdef.objectoptions,oo_is_forward); include(current_structdef.objectoptions,oo_is_forward);
end end
else else
@ -1343,7 +1343,7 @@ implementation
Message(parser_f_no_anonym_objects); Message(parser_f_no_anonym_objects);
{ create new class } { create new class }
current_structdef:=cobjectdef.create(objecttype,n,nil); current_structdef:=cobjectdef.create(objecttype,n,nil,true);
{ include always the forward flag, it'll be removed after the parent class have been { include always the forward flag, it'll be removed after the parent class have been
added. This is to prevent circular childof loops } added. This is to prevent circular childof loops }

4
compiler/pgenutil.pas
View File

@ -1141,7 +1141,7 @@ uses
if (basedef.typ<>objectdef) or if (basedef.typ<>objectdef) or
not (tobjectdef(basedef).objecttype in [odt_javaclass,odt_class]) then not (tobjectdef(basedef).objecttype in [odt_javaclass,odt_class]) then
internalerror(2012101101); internalerror(2012101101);
basedef:=cobjectdef.create(tobjectdef(basedef).objecttype,defname,tobjectdef(basedef)); basedef:=cobjectdef.create(tobjectdef(basedef).objecttype,defname,tobjectdef(basedef),true);
for i:=0 to constraintdata.interfaces.count-1 do for i:=0 to constraintdata.interfaces.count-1 do
tobjectdef(basedef).implementedinterfaces.add( tobjectdef(basedef).implementedinterfaces.add(
timplementedinterface.create(tobjectdef(constraintdata.interfaces[i]))); timplementedinterface.create(tobjectdef(constraintdata.interfaces[i])));
@ -1152,7 +1152,7 @@ uses
if basedef.typ<>errordef then if basedef.typ<>errordef then
internalerror(2013021601); internalerror(2013021601);
def:=tdef(constraintdata.interfaces[0]); def:=tdef(constraintdata.interfaces[0]);
basedef:=cobjectdef.create(tobjectdef(def).objecttype,defname,tobjectdef(def)); basedef:=cobjectdef.create(tobjectdef(def).objecttype,defname,tobjectdef(def),true);
constraintdata.interfaces.delete(0); constraintdata.interfaces.delete(0);
end; end;
if basedef.typ<>errordef then if basedef.typ<>errordef then

2
compiler/pmodules.pas
View File

@ -719,7 +719,7 @@ implementation
{ java_jlobject may not have been parsed yet (system unit); in any { java_jlobject may not have been parsed yet (system unit); in any
case, we only use this to refer to the class type, so inheritance case, we only use this to refer to the class type, so inheritance
does not matter } does not matter }
def:=cobjectdef.create(odt_javaclass,'__FPC_JVM_Module_Class_Alias$',nil); def:=cobjectdef.create(odt_javaclass,'__FPC_JVM_Module_Class_Alias$',nil,true);
include(def.objectoptions,oo_is_external); include(def.objectoptions,oo_is_external);
include(def.objectoptions,oo_is_sealed); include(def.objectoptions,oo_is_sealed);
def.objextname:=stringdup(current_module.realmodulename^); def.objextname:=stringdup(current_module.realmodulename^);

18
compiler/symdef.pas
View File

@ -263,7 +263,7 @@ interface
{ for targets that initialise typed constants via explicit assignments { for targets that initialise typed constants via explicit assignments
instead of by generating an initialised data sectino } instead of by generating an initialised data sectino }
tcinitcode : tnode; tcinitcode : tnode;
constructor create(const n:string; dt:tdeftyp); constructor create(const n:string; dt:tdeftyp;doregister:boolean);
constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile); constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override;
destructor destroy; override; destructor destroy; override;
@ -413,7 +413,7 @@ interface
} }
classref_created_in_current_module : boolean; classref_created_in_current_module : boolean;
objecttype : tobjecttyp; objecttype : tobjecttyp;
constructor create(ot:tobjecttyp;const n:string;c:tobjectdef);virtual; constructor create(ot:tobjecttyp;const n:string;c:tobjectdef;doregister:boolean);virtual;
constructor ppuload(ppufile:tcompilerppufile); constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override; destructor destroy;override;
function getcopy : tstoreddef;override; function getcopy : tstoreddef;override;
@ -3734,9 +3734,9 @@ implementation
tabstractrecorddef tabstractrecorddef
***************************************************************************} ***************************************************************************}
constructor tabstractrecorddef.create(const n:string; dt:tdeftyp); constructor tabstractrecorddef.create(const n:string; dt:tdeftyp;doregister:boolean);
begin begin
inherited create(dt,true); inherited create(dt,doregister);
objname:=stringdup(upper(n)); objname:=stringdup(upper(n));
objrealname:=stringdup(n); objrealname:=stringdup(n);
objectoptions:=[]; objectoptions:=[];
@ -4104,7 +4104,7 @@ implementation
constructor trecorddef.create(const n:string; p:TSymtable); constructor trecorddef.create(const n:string; p:TSymtable);
begin begin
inherited create(n,recorddef); inherited create(n,recorddef,true);
symtable:=p; symtable:=p;
{ we can own the symtable only if nobody else owns a copy so far } { we can own the symtable only if nobody else owns a copy so far }
if symtable.refcount=1 then if symtable.refcount=1 then
@ -4131,7 +4131,7 @@ implementation
symtable:=trecordsymtable.create(n,packrecords,recordalignmin,maxCrecordalign); symtable:=trecordsymtable.create(n,packrecords,recordalignmin,maxCrecordalign);
symtable.defowner:=self; symtable.defowner:=self;
isunion:=false; isunion:=false;
inherited create(n,recorddef); inherited create(n,recorddef,true);
{ if we specified a name, then we'll probably want to look up the { if we specified a name, then we'll probably want to look up the
type again by name too -> create typesym } type again by name too -> create typesym }
ts:=nil; ts:=nil;
@ -6125,9 +6125,9 @@ implementation
TOBJECTDEF TOBJECTDEF
***************************************************************************} ***************************************************************************}
constructor tobjectdef.create(ot:tobjecttyp;const n:string;c:tobjectdef); constructor tobjectdef.create(ot:tobjecttyp;const n:string;c:tobjectdef;doregister:boolean);
begin begin
inherited create(n,objectdef); inherited create(n,objectdef,doregister);
fcurrent_dispid:=0; fcurrent_dispid:=0;
objecttype:=ot; objecttype:=ot;
childof:=nil; childof:=nil;
@ -6310,7 +6310,7 @@ implementation
var var
i : longint; i : longint;
begin begin
result:=cobjectdef.create(objecttype,objrealname^,childof); result:=cobjectdef.create(objecttype,objrealname^,childof,true);
{ the constructor allocates a symtable which we release to avoid memory leaks } { the constructor allocates a symtable which we release to avoid memory leaks }
tobjectdef(result).symtable.free; tobjectdef(result).symtable.free;
tobjectdef(result).symtable:=symtable.getcopy; tobjectdef(result).symtable:=symtable.getcopy;