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

compiler:

Browse Source 
- add own symbol table for enumeration to store enumeration elements
  - reimplement enumeration member traverse using symbol table instead of firstenum/nextenum - that members are removed
  - implement TEnum.Element access syntax - element is searched in the enumeration symtable in this case instead of global/local symtables
  - implement {$SCOPEDENUM ON/OFF} local switch
  + tests

git-svn-id: trunk@15051 -
This commit is contained in:
paul 2010-03-25 05:46:53 +00:00
parent 4d8f578e4c
commit 1b614b526a
20 changed files with 281 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -8966,6 +8966,9 @@ tests/test/tdispinterface2.pp svneol=native#text/plain
tests/test/tendian1.pp svneol=native#text/plain
tests/test/tenum1.pp svneol=native#text/plain
tests/test/tenum2.pp svneol=native#text/plain
tests/test/tenum3.pp svneol=native#text/plain
tests/test/tenum4.pp svneol=native#text/plain
tests/test/tenum5.pp svneol=native#text/plain
tests/test/tenumerators1.pp svneol=native#text/pascal
tests/test/testcmem.pp svneol=native#text/plain
tests/test/testda1.pp svneol=native#text/plain

16
compiler/browcol.pas
View File

@ -1259,19 +1259,17 @@ end;
end;
function GetDefinitionStr(def: tdef): string; forward;
function GetEnumDefStr(def: tenumdef): string;
var Name: string;
esym: tenumsym;
Count: integer;
var
Name: string;
esym: tenumsym;
i: integer;
begin
Name:='(';
esym:=tenumsym(def.Firstenum); Count:=0;
while (esym<>nil) do
for i := 0 to def.symtable.SymList.Count - 1 do
begin
if Count>0 then
if i>0 then
Name:=Name+', ';
Name:=Name+esym.name;
esym:=esym.nextenum;
Inc(Count);
Name:=Name+tenumsym(def.symtable.SymList[i]).name;
end;
Name:=Name+')';
GetEnumDefStr:=Name;

11
compiler/dbgdwarf.pas
View File

@ -1330,6 +1330,7 @@ implementation
procedure TDebugInfoDwarf.appenddef_enum(list:TAsmList;def:tenumdef);
var
hp : tenumsym;
i : integer;
begin
if assigned(def.typesym) then
append_entry(DW_TAG_enumeration_type,true,[
@ -1345,15 +1346,19 @@ implementation
finish_entry;
{ write enum symbols }
hp:=tenumsym(def.firstenum);
while assigned(hp) do
for i := 0 to def.symtable.SymList.Count - 1 do
begin
hp:=tenumsym(def.symtable.SymList[i]);
if hp.value<def.minval then
continue
else
if hp.value>def.maxval then
break;
append_entry(DW_TAG_enumerator,false,[
DW_AT_name,DW_FORM_string,symname(hp)+#0,
DW_AT_const_value,DW_FORM_data4,hp.value
]);
finish_entry;
hp:=tenumsym(hp).nextenum;
end;
finish_children;

10
compiler/dbgstabs.pas
View File

@ -575,7 +575,6 @@ implementation
result:='@s'+tostr(def.size*8)+';e'
else
result:='e';
p := tenumsym(def.firstenum);
{ the if-test is required because pred(def.minval) might overflow;
the longint() typecast should be safe because stabs is not
supported for 64 bit targets }
@ -583,10 +582,15 @@ implementation
for i:=lowerbound to pred(longint(def.minval)) do
result:=result+'<invalid>:'+tostr(i)+',';
while assigned(p) do
for i := 0 to def.symtable.SymList.Count - 1 do
begin
p := tenumsym(def.symtable.SymList[i]);
if p.value<def.minval then
continue
else
if p.value>def.maxval then
break;
result:=result+GetSymName(p)+':'+tostr(p.value)+',';
p:=p.nextenum;
end;
{ the final ',' is required to have a valid stabs }
result:=result+';';

2
compiler/defcmp.pas
View File

@ -594,7 +594,7 @@ implementation
begin
{ assignment of an enum symbol to an unique type? }
if (fromtreetype=ordconstn) and
(tenumsym(tenumdef(hd1).firstenum)=tenumsym(tenumdef(hd2).firstenum)) then
(tenumsym(tenumdef(hd1).getfirstsym)=tenumsym(tenumdef(hd2).getfirstsym)) then
begin
{ because of packenum they can have different sizes! (JM) }
eq:=te_convert_l1;

2
compiler/globtype.pas
View File

@ -110,7 +110,7 @@ interface
cs_mmx,cs_mmx_saturation,
{ parser }
cs_typed_addresses,cs_strict_var_strings,cs_ansistrings,cs_bitpacking,
cs_varpropsetter,
cs_varpropsetter,cs_scopedenums,
{ macpas specific}
cs_external_var, cs_externally_visible
);

32
compiler/ncgrtti.pas
View File

@ -416,6 +416,7 @@ implementation
procedure enumdef_rtti(def:tenumdef);
var
i : integer;
hp : tenumsym;
begin
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkEnumeration));
@ -441,13 +442,16 @@ implementation
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.basedef,rt)))
else
current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
{ write name list }
hp:=tenumsym(def.firstenum);
while assigned(hp) do
for i := 0 to def.symtable.SymList.Count - 1 do
begin
hp:=tenumsym(def.symtable.SymList[i]);
if hp.value<def.minval then
continue
else
if hp.value>def.maxval then
break;
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(hp.realname)));
current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(hp.realname));
hp:=hp.nextenum;
end;
{ write unit name }
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(current_module.realmodulename^)));
@ -969,9 +973,14 @@ implementation
sym_count:=0;
sym_alloc:=64;
st:=0;
t:=Tenumsym(def.firstenum);
while assigned(t) do
for i := 0 to def.symtable.SymList.Count - 1 do
begin
t:=tenumsym(def.symtable.SymList[i]);
if t.value<def.minval then
continue
else
if t.value>def.maxval then
break;
if sym_count>=sym_alloc then
begin
reallocmem(syms,2*sym_alloc*sizeof(Tenumsym));
@ -982,7 +991,6 @@ implementation
offsets[sym_count]:=st;
inc(sym_count);
st:=st+length(t.realname)+1;
t:=t.nextenum;
end;
{Sort the syms by enum value}
if sym_count>=2 then
@ -1098,9 +1106,14 @@ implementation
sym_count:=0;
sym_alloc:=64;
st:=0;
t:=Tenumsym(def.firstenum);
while assigned(t) do
for i := 0 to def.symtable.SymList.Count - 1 do
begin
t:=tenumsym(def.symtable.SymList[i]);
if t.value<def.minval then
continue
else
if t.value>def.maxval then
break;
if sym_count>=sym_alloc then
begin
reallocmem(syms,2*sym_alloc*sizeof(Tenumsym));
@ -1111,7 +1124,6 @@ implementation
offsets[sym_count]:=st;
inc(sym_count);
st:=st+length(t.realname)+1;
t:=t.nextenum;
end;
{Sort the syms by enum name}
if sym_count>=2 then

15
compiler/ninl.pas
View File

@ -1330,6 +1330,7 @@ implementation
v : tconstexprint;
enum : tenumsym;
hp : tnode;
i : integer;
begin
case def.typ of
orddef:
@ -1346,11 +1347,17 @@ implementation
enumdef:
begin
set_varstate(left,vs_read,[]);
enum:=tenumsym(tenumdef(def).firstenum);
v:=tenumdef(def).maxval;
if inlinenumber=in_high_x then
while assigned(enum) and (enum.value <> v) do
enum:=enum.nextenum;
v:=tenumdef(def).maxval
else
v:=tenumdef(def).minval;
enum:=nil;
for i := 0 to tenumdef(def).symtable.SymList.Count - 1 do
if tenumsym(tenumdef(def).symtable.SymList[i]).value=v then
begin
enum:=tenumsym(tenumdef(def).symtable.SymList[i]);
break;
end;
if not assigned(enum) then
internalerror(309993)
else

7
compiler/nset.pas
View File

@ -190,18 +190,15 @@ implementation
function createsetconst(psd : tsetdef) : pconstset;
var
pcs : pconstset;
pes : tenumsym;
i : longint;
begin
new(pcs);
case psd.elementdef.typ of
enumdef :
begin
pes:=tenumsym(tenumdef(psd.elementdef).firstenum);
while assigned(pes) do
for i := 0 to tenumdef(psd.elementdef).symtable.SymList.Count - 1 do
begin
include(pcs^,pes.value);
pes:=pes.nextenum;
include(pcs^,tenumsym(tenumdef(psd.elementdef).symtable.SymList[i]).value);
end;
end;
orddef :

25
compiler/pexpr.pas
View File

@ -2050,9 +2050,28 @@ implementation
p1.destroy;
p1:=cerrornode.create;
end;
end;
consume(_ID);
end;
end;
consume(_ID);
end;
enumdef:
begin
if token=_ID then
begin
srsym:=tsym(tenumdef(p1.resultdef).symtable.Find(pattern));
p1.destroy;
if assigned(srsym) and (srsym.typ=enumsym) then
begin
check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
p1:=genenumnode(tenumsym(srsym));
end
else
begin
Message1(sym_e_id_no_member,orgpattern);
p1:=cerrornode.create;
end;
end;
consume(_ID);
end;
variantdef:
begin
{ dispatch call? }

2
compiler/ppu.pas
View File

@ -43,7 +43,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion = 116;
CurrentPPUVersion = 117;
{ buffer sizes }
maxentrysize = 1024;

6
compiler/ptype.pas
View File

@ -840,7 +840,7 @@ implementation
pd : tabstractprocdef;
is_func,
enumdupmsg, first : boolean;
newtype : ttypesym;
newtype : ttypesym;
oldlocalswitches : tlocalswitches;
bitpacking: boolean;
begin
@ -904,7 +904,9 @@ implementation
first := false;
storepos:=current_tokenpos;
current_tokenpos:=defpos;
tstoredsymtable(aktenumdef.owner).insert(tenumsym.create(s,aktenumdef,longint(l.svalue)));
tenumsymtable(aktenumdef.symtable).insert(tenumsym.create(s,aktenumdef,longint(l.svalue)));
if not (cs_scopedenums in current_settings.localswitches) then
tstoredsymtable(aktenumdef.owner).insert(tenumsym.create(s,aktenumdef,longint(l.svalue)));
current_tokenpos:=storepos;
until not try_to_consume(_COMMA);
def:=aktenumdef;

6
compiler/scandir.pas
View File

@ -1019,6 +1019,11 @@ unit scandir;
do_localswitch(cs_fpu_fwait);
end;
procedure dir_scopedenums;
begin
do_localswitch(cs_scopedenums);
end;
procedure dir_setpeflags;
begin
if not (target_info.system in (systems_all_windows)) then
@ -1447,6 +1452,7 @@ unit scandir;
AddDirective('RESOURCE',directive_all, @dir_resource);
AddDirective('SATURATION',directive_all, @dir_saturation);
AddDirective('SAFEFPUEXCEPTIONS',directive_all, @dir_safefpuexceptions);
AddDirective('SCOPEDENUMS',directive_all, @dir_scopedenums);
AddDirective('SETPEFLAGS', directive_all, @dir_setpeflags);
AddDirective('SCREENNAME',directive_all, @dir_screenname);
AddDirective('SMARTLINK',directive_all, @dir_smartlink);

3
compiler/symconst.pas
View File

@ -419,7 +419,8 @@ type
ObjectSymtable,recordsymtable,
localsymtable,parasymtable,
withsymtable,stt_excepTSymtable,
exportedmacrosymtable, localmacrosymtable
exportedmacrosymtable, localmacrosymtable,
enumsymtable
);

85
compiler/symdef.pas
View File

@ -579,21 +579,23 @@ interface
function getvardef:longint;override;
end;
{ tenumdef }
tenumdef = class(tstoreddef)
minval,
maxval : aint;
has_jumps : boolean;
firstenum : tsym; {tenumsym}
basedef : tenumdef;
basedefderef : tderef;
symtable : TSymtable;
constructor create;
constructor create_subrange(_basedef:tenumdef;_min,_max:aint);
constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override;
function getcopy : tstoreddef;override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure buildderef;override;
procedure deref;override;
procedure derefimpl;override;
function GetTypeName:string;override;
function is_publishable : boolean;override;
procedure calcsavesize;
@ -602,6 +604,7 @@ interface
procedure setmin(_min:aint);
function min:aint;
function max:aint;
function getfirstsym:tsym;
end;
tsetdef = class(tstoreddef)
@ -1392,7 +1395,7 @@ implementation
calcsavesize;
has_jumps:=false;
basedef:=nil;
firstenum:=nil;
symtable:=tenumsymtable.create(self);
end;
@ -1404,21 +1407,37 @@ implementation
basedef:=_basedef;
calcsavesize;
has_jumps:=false;
firstenum:=basedef.firstenum;
while assigned(firstenum) and (tenumsym(firstenum).value<>minval) do
firstenum:=tenumsym(firstenum).nextenum;
end;
symtable:=basedef.symtable.getcopy;
include(defoptions, df_copied_def);
end;
constructor tenumdef.ppuload(ppufile:tcompilerppufile);
begin
inherited ppuload(enumdef,ppufile);
ppufile.getderef(basedefderef);
minval:=ppufile.getaint;
maxval:=ppufile.getaint;
savesize:=ppufile.getaint;
has_jumps:=false;
firstenum:=Nil;
if df_copied_def in defoptions then
begin
symtable:=nil;
ppufile.getderef(basedefderef);
end
else
begin
// create with nil defowner first to prevent values changes on insert
symtable:=tenumsymtable.create(nil);
tenumsymtable(symtable).ppuload(ppufile);
symtable.defowner:=self;
end;
end;
destructor tenumdef.destroy;
begin
symtable.free;
symtable:=nil;
inherited destroy;
end;
@ -1431,10 +1450,13 @@ implementation
result:=tenumdef.create;
tenumdef(result).minval:=minval;
tenumdef(result).maxval:=maxval;
tenumdef(result).symtable.free;
tenumdef(result).symtable:=symtable.getcopy;
tenumdef(result).basedef:=self;
end;
tenumdef(result).has_jumps:=has_jumps;
tenumdef(result).firstenum:=firstenum;
tenumdef(result).basedefderef:=basedefderef;
include(tenumdef(result).defoptions,df_copied_def);
end;
@ -1501,43 +1523,54 @@ implementation
max:=maxval;
end;
function tenumdef.getfirstsym: tsym;
var
i:integer;
begin
for i := 0 to symtable.SymList.Count - 1 do
begin
result:=tsym(symtable.SymList[i]);
if tenumsym(result).value=minval then
exit;
end;
result:=nil;
end;
procedure tenumdef.buildderef;
begin
inherited buildderef;
basedefderef.build(basedef);
if df_copied_def in defoptions then
basedefderef.build(basedef)
else
tenumsymtable(symtable).buildderef;
end;
procedure tenumdef.deref;
begin
inherited deref;
basedef:=tenumdef(basedefderef.resolve);
{ restart ordering }
firstenum:=nil;
end;
procedure tenumdef.derefimpl;
begin
if assigned(basedef) and
(firstenum=nil) then
if df_copied_def in defoptions then
begin
firstenum:=basedef.firstenum;
while assigned(firstenum) and (tenumsym(firstenum).value<>minval) do
firstenum:=tenumsym(firstenum).nextenum;
end;
basedef:=tenumdef(basedefderef.resolve);
symtable:=basedef.symtable.getcopy;
end
else
tenumsymtable(symtable).deref;
end;
procedure tenumdef.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putderef(basedefderef);
ppufile.putaint(min);
ppufile.putaint(max);
ppufile.putaint(savesize);
if df_copied_def in defoptions then
ppufile.putderef(basedefderef);
ppufile.writeentry(ibenumdef);
if not (df_copied_def in defoptions) then
tenumsymtable(symtable).ppuwrite(ppufile);
end;

50
compiler/symsym.pas
View File

@ -277,13 +277,11 @@ interface
value : longint;
definition : tenumdef;
definitionderef : tderef;
nextenum : tenumsym;
constructor create(const n : string;def : tenumdef;v : longint);
constructor ppuload(ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure buildderef;override;
procedure deref;override;
procedure order;
end;
tsyssym = class(Tstoredsym)
@ -1774,26 +1772,6 @@ implementation
inherited create(enumsym,n);
definition:=def;
value:=v;
{ First entry? Then we need to set the minval }
if def.firstenum=nil then
begin
if v>0 then
def.has_jumps:=true;
def.setmin(v);
def.setmax(v);
end
else
begin
{ check for jumps }
if v>def.max+1 then
def.has_jumps:=true;
{ update low and high }
if def.min>v then
def.setmin(v);
if def.max<v then
def.setmax(v);
end;
order;
end;
@ -1802,7 +1780,6 @@ implementation
inherited ppuload(enumsym,ppufile);
ppufile.getderef(definitionderef);
value:=ppufile.getlongint;
nextenum := Nil;
end;
@ -1815,33 +1792,6 @@ implementation
procedure tenumsym.deref;
begin
definition:=tenumdef(definitionderef.resolve);
order;
end;
procedure tenumsym.order;
var
sym : tenumsym;
begin
sym := tenumsym(definition.firstenum);
if sym = nil then
begin
definition.firstenum := self;
nextenum := nil;
exit;
end;
{ reorder the symbols in increasing value }
if value < sym.value then
begin
nextenum := sym;
definition.firstenum := self;
end
else
begin
while (sym.value <= value) and assigned(sym.nextenum) do
sym := sym.nextenum;
nextenum := sym.nextenum;
sym.nextenum := self;
end;
end;
procedure tenumsym.ppuwrite(ppufile:tcompilerppufile);

51
compiler/symtable.pas
View File

@ -173,6 +173,14 @@ interface
constructor create(exported: boolean);
end;
{ tenumsymtable }
tenumsymtable = class(tstoredsymtable)
public
procedure insert(sym: TSymEntry; checkdup: boolean = true); override;
constructor create(adefowner:tdef);
end;
var
systemunit : tglobalsymtable; { pointer to the system unit }
@ -1508,6 +1516,49 @@ implementation
symtablelevel:=main_program_level;
end;
{****************************************************************************
TEnumSymtable
****************************************************************************}
procedure tenumsymtable.insert(sym: TSymEntry; checkdup: boolean);
var
value: longint;
def: tenumdef;
begin
// defowner = nil only when we are loading from ppu
if defowner<>nil then
begin
{ First entry? Then we need to set the minval }
value:=tenumsym(sym).value;
def:=tenumdef(defowner);
if SymList.count=0 then
begin
if value>0 then
def.has_jumps:=true;
def.setmin(value);
def.setmax(value);
end
else
begin
{ check for jumps }
if value>def.max+1 then
def.has_jumps:=true;
{ update low and high }
if def.min>value then
def.setmin(value);
if def.max<value then
def.setmax(value);
end;
end;
inherited insert(sym, checkdup);
end;
constructor tenumsymtable.create(adefowner: tdef);
begin
inherited Create('');
symtabletype:=enumsymtable;
defowner:=adefowner;
end;
{*****************************************************************************
Helper Routines

39
tests/test/tenum3.pp Normal file
View File

@ -0,0 +1,39 @@
// test that enumeration members are retrieved from the right enumeration types
// test enumeration.element syntax
// test scropedenums directive
program tenum3;
uses
typinfo;
type
{$SCOPEDENUMS ON}
TEnum1 = (first, second, third);
{$SCOPEDENUMS OFF}
TEnum2 = (zero, first, second, third);
TRange1 = first..second;
var
En1: TEnum1;
En2: TEnum2;
R1: TRange1;
begin
En1 := TEnum1.first;
if GetEnumName(TypeInfo(TEnum1), Ord(En1)) <> 'first' then
halt(1);
if Ord(En1) <> 0 then
halt(2);
En2 := first;
if GetEnumName(TypeInfo(TEnum2), Ord(En2)) <> 'first' then
halt(3);
if ord(En2) <> 1 then
halt(4);
En2 := TEnum2.second;
if GetEnumName(TypeInfo(TEnum2), Ord(En2)) <> 'second' then
halt(5);
if ord(En2) <> 2 then
halt(6);
R1 := TRange1.second;
if GetEnumName(TypeInfo(TRange1), Ord(R1)) <> 'second' then
halt(7);
if ord(R1) <> 2 then
halt(8);
writeln('ok');
end.

18
tests/test/tenum4.pp Normal file
View File

@ -0,0 +1,18 @@
{ %fail}
{ %norun}
// test checks that enumeration memebers are not present in the global/local symtables
// if enumeration is defined with scopedenums directive
program tenum4;
type
{$SCOPEDENUMS ON}
TEnum1 = (first, second, third);
{$SCOPEDENUMS OFF}
TEnum2 = (zero, first, second, third);
var
En1: TEnum1;
begin
// this is not possible since first belongs to TEnum2
En1 := first;
end.

17
tests/test/tenum5.pp Normal file
View File

@ -0,0 +1,17 @@
{ %fail}
{ %norun}
// test checks that enumeration searches symbols only in the own symbol list
// if they are prefixed by the enumeration name
program tenum5;
type
{$SCOPEDENUMS ON}
TEnum1 = (first, second, third);
{$SCOPEDENUMS OFF}
TEnum2 = (zero, first, second, third);
var
En1: TEnum1;
begin
En1 := TEnum1.zero;
end.