paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-30 23:42:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler: implement 'var' and 'class var' sections for classes + tests

Browse Source 
git-svn-id: trunk@14598 -
This commit is contained in:
paul 2010-01-10 13:48:43 +00:00
parent 6b63837ae7
commit 4b53a54b51
6 changed files with 43 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
compiler/pdecobj.pas
View File

@ -526,7 +526,7 @@ implementation
oldparse_only,
old_parse_generic : boolean;
object_member_blocktype : tblock_type;
fields_allowed, is_classdef: boolean;
fields_allowed, is_classdef, classfields: boolean;
begin
{ empty class declaration ? }
if (current_objectdef.objecttype in [odt_class,odt_objcclass]) and
@ -545,6 +545,7 @@ implementation
has_destructor:=false;
fields_allowed:=true;
is_classdef:=false;
classfields:=false;
object_member_blocktype:=bt_general;
repeat
case token of
@ -557,10 +558,14 @@ implementation
end;
_VAR :
begin
if ([df_generic,df_specialization]*current_objectdef.defoptions)=[] then
if (([df_generic,df_specialization]*current_objectdef.defoptions)=[]) and
(current_objectdef.objecttype<>odt_class) then
Message(parser_e_type_and_var_only_in_generics);
consume(_VAR);
fields_allowed:=true;
object_member_blocktype:=bt_general;
classfields:=is_classdef;
is_classdef:=false;
end;
_ID :
begin
@ -659,7 +664,10 @@ implementation
if (not fields_allowed) then
Message(parser_e_field_not_allowed_here);
read_record_fields([vd_object])
if classfields then
read_record_fields([vd_object,vd_class])
else
read_record_fields([vd_object])
end
else
types_dec;
@ -679,7 +687,7 @@ implementation
if try_to_consume(_CLASS) then
begin
{ class method only allowed for procedures and functions }
if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY]) then
if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR]) then
Message(parser_e_procedure_or_function_expected);
if is_interface(current_objectdef) then

42
compiler/pdecvar.pas
View File

@ -30,7 +30,7 @@ interface
symsym,symdef;
type
tvar_dec_option=(vd_record,vd_object,vd_threadvar);
tvar_dec_option=(vd_record,vd_object,vd_threadvar,vd_class);
tvar_dec_options=set of tvar_dec_option;
function read_property_dec(is_classproperty:boolean; aclass:tobjectdef):tpropertysym;
@ -1466,27 +1466,33 @@ implementation
(hdef.typesym=nil) then
handle_calling_convention(tprocvardef(hdef));
{ Check for STATIC directive }
if (vd_object in options) and
(try_to_consume(_STATIC)) then
{ check if it is a class field }
if (vd_object in options) then
begin
{ add static flag and staticvarsyms }
for i:=0 to sc.count-1 do
{ if it is not a class var section and token=STATIC then it is a class field too }
if not (vd_class in options) and try_to_consume(_STATIC) then
begin
fieldvs:=tfieldvarsym(sc[i]);
include(fieldvs.symoptions,sp_static);
{ generate the symbol which reserves the space }
hstaticvs:=tstaticvarsym.create('$_static_'+lower(symtablestack.top.name^)+'_'+fieldvs.name,vs_value,hdef,[]);
recst.defowner.owner.insert(hstaticvs);
insertbssdata(hstaticvs);
{ generate the symbol for the access }
sl:=tpropaccesslist.create;
sl.addsym(sl_load,hstaticvs);
recst.insert(tabsolutevarsym.create_ref('$'+lower(symtablestack.top.name^)+'_'+fieldvs.name,hdef,sl));
consume(_SEMICOLON);
include(options, vd_class);
end;
consume(_SEMICOLON);
if vd_class in options then
begin
{ add static flag and staticvarsyms }
for i:=0 to sc.count-1 do
begin
fieldvs:=tfieldvarsym(sc[i]);
include(fieldvs.symoptions,sp_static);
{ generate the symbol which reserves the space }
hstaticvs:=tstaticvarsym.create('$_static_'+lower(symtablestack.top.name^)+'_'+fieldvs.name,vs_value,hdef,[]);
recst.defowner.owner.insert(hstaticvs);
insertbssdata(hstaticvs);
{ generate the symbol for the access }
sl:=tpropaccesslist.create;
sl.addsym(sl_load,hstaticvs);
recst.insert(tabsolutevarsym.create_ref('$'+lower(symtablestack.top.name^)+'_'+fieldvs.name,hdef,sl));
end;
end;
end;
if (visibility=vis_published) and
not(is_class(hdef)) then
begin

2
compiler/psub.pas
View File

@ -1737,7 +1737,7 @@ implementation
if try_to_consume(_CLASS) then
begin
{ class method only allowed for procedures and functions }
if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY]) then
if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR]) then
Message(parser_e_procedure_or_function_expected);
if is_interface(current_objectdef) then

3
tests/test/tstatic1.pp
View File

@ -7,7 +7,8 @@ program tstatic1;
type
TSomeClass = class
private
{$ifndef fpc}class var{$endif}FSomethingStatic: Integer; {$ifdef fpc}static;{$endif}
class var
FSomethingStatic: Integer;
public
class procedure SomeClassMethod(A: Integer);
class procedure SomeStaticMethod(A: Integer); static;

3
tests/test/tstatic2.pp
View File

@ -7,7 +7,8 @@ program tstatic2;
type
TSomeClass = class
private
{$ifndef fpc}class var{$endif}FSomethingStatic: Integer; {$ifdef fpc}static;{$endif}
class var
FSomethingStatic: Integer;
public
class procedure SetSomethingStatic(AValue: Integer); static;
class property SomethingStatic: Integer read FSomethingStatic write SetSomethingStatic;

4
tests/test/tstatic3.pp
View File

@ -8,8 +8,8 @@ program tstatic3;
type
TSomeClass = class
private
{$ifndef fpc}class var{$endif}FSomethingStatic: Integer;
{$ifndef fpc}var{$endif} FSomethingRegular: Integer;
class var FSomethingStatic: Integer;
var FSomethingRegular: Integer;
class procedure SetSomethingStatic(AValue: Integer); static;
public
class property SomethingStatic: Integer read FSomethingStatic write SetSomethingStatic;