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

* generic constructor implemented

Browse Source
This commit is contained in:
carl 2002-05-16 19:58:05 +00:00
parent 21b3a10f02
commit fbf499b13d
1 changed files with 25 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
rtl/inc/generic.inc
View File

@ -344,7 +344,7 @@ function fpc_help_constructor(var _self : pointer; var vmt : pointer; vmt_pos :
begin begin
if vmt=nil then if vmt=nil then
begin begin
int_help_constructor:=_self; fpc_help_constructor:=_self;
exit; exit;
end; end;
vmtcopy:=vmt; vmtcopy:=vmt;
@ -359,7 +359,7 @@ begin
fillchar(_self^,objectsize,#0); fillchar(_self^,objectsize,#0);
ppointer(_self+vmt_pos)^:=vmtcopy; ppointer(_self+vmt_pos)^:=vmtcopy;
end; end;
int_help_constructor:=_self; fpc_help_constructor:=_self;
end; end;
{$endif ndef FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR} {$endif ndef FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
@ -421,12 +421,27 @@ begin
else else
ppointer(_self+vmt_pos)^:=nil; ppointer(_self+vmt_pos)^:=nil;
end; end;
{$endif FPC_SYSTEM_HAS_FPC_HELP_FAIL}
{$endif ndef FPC_SYSTEM_HAS_FPC_HELP_FAIL}
{$ifndef FPC_SYSTEM_HAS_FPC_NEW_CLASS} {$ifndef FPC_SYSTEM_HAS_FPC_NEW_CLASS}
{$error No pascal version of Int_new_class} { the constructor receives as first parameter a pointer }
{$endif ndef FPC_SYSTEM_HAS_FPC_NEW_CLASS} { to the vmt or nil, if called when class already instanciated }
{ RETURNS SELF }
{ IMPORTANT: SELF REGISTER should be pre-loaded before call to }
{ constructor for this to work! }
function fpc_new_class(_vmt: pointer; _self : pointer):pointer;saveregisters;[public,alias:'FPC_NEW_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
begin
if _vmt <> nil then
begin
fpc_new_class := TObject.NewInstance;
end
else
begin
{ calling when class already instanciated }
fpc_new_class := _self;
end;
end;
{$endif FPC_SYSTEM_HAS_FPC_NEW_CLASS}
{$ifndef FPC_SYSTEM_HAS_FPC_DISPOSE_CLASS} {$ifndef FPC_SYSTEM_HAS_FPC_DISPOSE_CLASS}
{$error No pascal version of Int_dispose_class} {$error No pascal version of Int_dispose_class}
@ -926,7 +941,10 @@ end;
{ {
$Log$ $Log$
Revision 1.24 2002-03-30 13:08:54 carl Revision 1.25 2002-05-16 19:58:05 carl
* generic constructor implemented
Revision 1.24 2002/03/30 13:08:54 carl
* memory corruption bugfix in FPC_HELP_CONSTRUCTOR if object cannot be allocated * memory corruption bugfix in FPC_HELP_CONSTRUCTOR if object cannot be allocated
Revision 1.23 2002/01/25 17:38:55 peter Revision 1.23 2002/01/25 17:38:55 peter