paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-04 04:57:23 +01:00
Code Issues Packages Projects Releases Wiki Activity

compiler: implement delphi like namespaces

Browse Source 
git-svn-id: branches/paul/namespaces@18859 -
This commit is contained in:
paul 2011-08-27 03:52:07 +00:00
parent d3e19b711c
commit de21de2024
9 changed files with 238 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
compiler/dbgbase.pas
View File

@ -420,6 +420,9 @@ implementation
appendsym_absolute(list,tabsolutevarsym(sym));
propertysym :
appendsym_property(list,tpropertysym(sym));
namespacesym :
{ ignore namespace syms, they are only of internal use }
;
else
internalerror(200601242);
end;

2
compiler/fmodule.pas
View File

@ -471,7 +471,7 @@ implementation
var
n : string;
begin
n:=ChangeFileExt(ExtractFileName(s),'');
n:=s;
{ Programs have the name 'Program' to don't conflict with dup id's }
if _is_unit then
inherited create(n)

38
compiler/pbase.pas
View File

@ -243,12 +243,13 @@ implementation
function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id:boolean):boolean;
var
hmodule: tmodule;
ns:string;
nssym:tsym;
begin
// TODO: dot units
result:=false;
tokentoconsume:=_ID;
if assigned(srsym) and
(srsym.typ=unitsym) then
if assigned(srsym) and (srsym.typ in [unitsym,namespacesym]) then
begin
if not(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) then
internalerror(200501154);
@ -264,6 +265,35 @@ implementation
if consume_id then
consume(_ID);
consume(_POINT);
if srsym.typ=namespacesym then
begin
ns:=srsym.name;
nssym:=srsym;
while assigned(srsym) and (srsym.typ=namespacesym) do
begin
{ we have a namespace. the next identifier should be either a namespace or a unit }
searchsym_in_module(hmodule,ns+'.'+pattern,srsym,srsymtable);
if assigned(srsym) and (srsym.typ in [namespacesym,unitsym]) then
begin
ns:=ns+'.'+pattern;
nssym:=srsym;
consume(_ID);
consume(_POINT);
end;
end;
{ check if there is a hidden unit with this pattern in the namespace }
if not assigned(srsym) and
assigned(nssym) and (nssym.typ=namespacesym) and assigned(tnamespacesym(nssym).unitsym) then
srsym:=tnamespacesym(nssym).unitsym;
if assigned(srsym) and (srsym.typ<>unitsym) then
internalerror(201108260);
if not assigned(srsym) then
begin
result:=true;
srsymtable:=nil;
exit;
end;
end;
case token of
_ID:
searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable);
@ -279,7 +309,7 @@ implementation
tokentoconsume:=_STRING;
end;
end
end;
end;
end
else
begin

119
compiler/pmodules.pas
View File

@ -533,7 +533,7 @@ implementation
{ insert unitsym }
unitsym:=tunitsym.create(s,hp);
inc(unitsym.refs);
current_module.localsymtable.insert(unitsym);
tabstractunitsymtable(current_module.localsymtable).insertunit(unitsym);
{ add to used units }
current_module.addusedunit(hp,false,unitsym);
end;
@ -748,6 +748,13 @@ implementation
s:=pattern;
sorg:=orgpattern;
consume(_ID);
while token=_POINT do
begin
consume(_POINT);
s:=s+'.'+pattern;
sorg:=sorg+'.'+orgpattern;
consume(_ID);
end;
{ support "<unit> in '<file>'" construct, but not for tp7 }
fn:='';
if not(m_tp7 in current_settings.modeswitches) and
@ -786,7 +793,7 @@ implementation
can not use the modulename because that can be different
when -Un is used }
unitsym:=tunitsym.create(sorg,nil);
current_module.localsymtable.insert(unitsym);
tabstractunitsymtable(current_module.localsymtable).insertunit(unitsym);
{ the current module uses the unit hp2 }
current_module.addusedunit(hp2,true,unitsym);
end
@ -1071,6 +1078,7 @@ implementation
force_init_final : boolean;
init_procinfo,
finalize_procinfo : tcgprocinfo;
unitname : string;
unitname8 : string[8];
ag: boolean;
{$ifdef debug_devirt}
@ -1087,49 +1095,53 @@ implementation
if compile_level=1 then
Status.IsExe:=false;
if token=_ID then
begin
{ create filenames and unit name }
main_file := current_scanner.inputfile;
while assigned(main_file.next) do
main_file := main_file.next;
unitname:=orgpattern;
consume(_ID);
while token=_POINT do
begin
consume(_POINT);
unitname:=unitname+'.'+orgpattern;
consume(_ID);
end;
new(s1);
s1^:=current_module.modulename^;
current_module.SetFileName(main_file.path^+main_file.name^,true);
current_module.SetModuleName(orgpattern);
{ create filenames and unit name }
main_file := current_scanner.inputfile;
while assigned(main_file.next) do
main_file := main_file.next;
{ check for system unit }
new(s2);
s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name^),''));
unitname8:=copy(current_module.modulename^,1,8);
if (cs_check_unit_name in current_settings.globalswitches) and
(
not(
(current_module.modulename^=s2^) or
(
(length(current_module.modulename^)>8) and
(unitname8=s2^)
)
)
or
new(s1);
s1^:=current_module.modulename^;
current_module.SetFileName(main_file.path^+main_file.name^,true);
current_module.SetModuleName(unitname);
{ check for system unit }
new(s2);
s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name^),''));
unitname8:=copy(current_module.modulename^,1,8);
if (cs_check_unit_name in current_settings.globalswitches) and
(
not(
(current_module.modulename^=s2^) or
(
(length(s1^)>8) and
(s1^<>current_module.modulename^)
(length(current_module.modulename^)>8) and
(unitname8=s2^)
)
) then
Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
if (current_module.modulename^='SYSTEM') then
include(current_settings.moduleswitches,cs_compilesystem);
dispose(s2);
dispose(s1);
end;
)
or
(
(length(s1^)>8) and
(s1^<>current_module.modulename^)
)
) then
Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
if (current_module.modulename^='SYSTEM') then
include(current_settings.moduleswitches,cs_compilesystem);
dispose(s2);
dispose(s1);
if (target_info.system in systems_unit_program_exports) then
exportlib.preparelib(current_module.realmodulename^);
consume(_ID);
{ parse hint directives }
try_consume_hintdirective(current_module.moduleoptions, current_module.deprecatedmsg);
@ -1162,7 +1174,7 @@ implementation
{ insert unitsym of this unit to prevent other units having
the same name }
current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
tabstractunitsymtable(current_module.localsymtable).insertunit(tunitsym.create(current_module.realmodulename^,current_module));
{ load default units, like the system unit }
loaddefaultunits;
@ -1857,7 +1869,7 @@ implementation
{Insert the name of the main program into the symbol table.}
if current_module.realmodulename^<>'' then
current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
tabstractunitsymtable(current_module.localsymtable).insertunit(tunitsym.create(current_module.realmodulename^,current_module));
Message1(parser_u_parsing_implementation,current_module.mainsource^);
@ -2050,6 +2062,7 @@ implementation
main_procinfo : tcgprocinfo;
force_init_final : boolean;
resources_used : boolean;
program_name : string;
begin
DLLsource:=islibrary;
Status.IsLibrary:=IsLibrary;
@ -2097,14 +2110,21 @@ implementation
if islibrary then
begin
consume(_LIBRARY);
current_module.setmodulename(orgpattern);
program_name:=orgpattern;
consume(_ID);
while token=_POINT do
begin
consume(_POINT);
program_name:=program_name+'.'+orgpattern;
consume(_ID);
end;
current_module.setmodulename(program_name);
current_module.islibrary:=true;
exportlib.preparelib(orgpattern);
exportlib.preparelib(program_name);
if tf_library_needs_pic in target_info.flags then
include(current_settings.moduleswitches,cs_create_pic);
consume(_ID);
consume(_SEMICOLON);
end
else
@ -2112,10 +2132,17 @@ implementation
if token=_PROGRAM then
begin
consume(_PROGRAM);
current_module.setmodulename(orgpattern);
if (target_info.system in systems_unit_program_exports) then
exportlib.preparelib(orgpattern);
program_name:=orgpattern;
consume(_ID);
while token=_POINT do
begin
consume(_POINT);
program_name:=program_name+'.'+orgpattern;
consume(_ID);
end;
current_module.setmodulename(program_name);
if (target_info.system in systems_unit_program_exports) then
exportlib.preparelib(program_name);
if token=_LKLAMMER then
begin
consume(_LKLAMMER);
@ -2158,7 +2185,7 @@ implementation
{Insert the name of the main program into the symbol table.}
if current_module.realmodulename^<>'' then
current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
tabstractunitsymtable(current_module.localsymtable).insertunit(tunitsym.create(current_module.realmodulename^,current_module));
Message1(parser_u_parsing_implementation,current_module.mainsource^);

4
compiler/ppu.pas
View File

@ -43,7 +43,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion = 135;
CurrentPPUVersion = 136;
{ buffer sizes }
maxentrysize = 1024;
@ -97,7 +97,7 @@ const
ibunitsym = 29;
iblabelsym = 30;
ibsyssym = 31;
// ibrttisym = 32;
ibnamespacesym = 32;
iblocalvarsym = 33;
ibparavarsym = 34;
ibmacrosym = 35;

4
compiler/symconst.pas
View File

@ -487,7 +487,7 @@ type
staticvarsym,localvarsym,paravarsym,fieldvarsym,
typesym,procsym,unitsym,constsym,enumsym,
errorsym,syssym,labelsym,absolutevarsym,propertysym,
macrosym
macrosym,namespacesym
);
{ State of the variable:
@ -593,7 +593,7 @@ const
'abstractsym','globalvar','localvar','paravar','fieldvar',
'type','proc','unit','const','enum',
'errorsym','system sym','label','absolutevar','property',
'macrosym'
'macrosym','namespace'
);
typName : array[tdeftyp] of string[12] = (

46
compiler/symsym.pas
View File

@ -78,6 +78,16 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override;
end;
tnamespacesym = class(Tstoredsym)
unitsym:tsym;
unitsymderef:tderef;
constructor create(const n : string);
constructor ppuload(ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure buildderef;override;
procedure deref;override;
end;
terrorsym = class(Tsym)
constructor create;
end;
@ -477,6 +487,42 @@ implementation
ppufile.writeentry(ibunitsym);
end;
{****************************************************************************
TNAMESPACESYM
****************************************************************************}
constructor tnamespacesym.create(const n : string);
begin
inherited create(namespacesym,n);
unitsym:=nil;
end;
constructor tnamespacesym.ppuload(ppufile:tcompilerppufile);
begin
inherited ppuload(namespacesym,ppufile);
ppufile.getderef(unitsymderef);
end;
procedure tnamespacesym.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putderef(unitsymderef);
ppufile.writeentry(ibnamespacesym);
end;
procedure tnamespacesym.buildderef;
begin
inherited buildderef;
unitsymderef.build(unitsym);
end;
procedure tnamespacesym.deref;
begin
inherited deref;
unitsym:=tsym(unitsymderef.resolve);
end;
{****************************************************************************
TPROCSYM
****************************************************************************}

110
compiler/symtable.pas
View File

@ -145,7 +145,9 @@ interface
tabstractuniTSymtable = class(tstoredsymtable)
public
constructor create(const n : string;id:word);
function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
function iscurrentunit:boolean;override;
procedure insertunit(sym:TSymEntry);
end;
tglobalsymtable = class(tabstractuniTSymtable)
@ -154,7 +156,6 @@ interface
constructor create(const n : string;id:word);
procedure ppuload(ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
end;
tstaticsymtable = class(tabstractuniTSymtable)
@ -455,6 +456,7 @@ implementation
iblabelsym : sym:=tlabelsym.ppuload(ppufile);
ibsyssym : sym:=tsyssym.ppuload(ppufile);
ibmacrosym : sym:=tmacro.ppuload(ppufile);
ibnamespacesym : sym:=tnamespacesym.ppuload(ppufile);
ibendsyms : break;
ibend : Message(unit_f_ppu_read_error);
else
@ -707,7 +709,7 @@ implementation
else
begin
if (tsym(sym).refs=0) and
not(tsym(sym).typ in [enumsym,unitsym]) and
not(tsym(sym).typ in [enumsym,unitsym,namespacesym]) and
not(is_funcret_sym(tsym(sym))) and
{ don't complain about compiler generated syms for specializations, see also #13405 }
not((tsym(sym).typ=typesym) and (df_specialization in ttypesym(sym).typedef.defoptions) and
@ -1460,6 +1462,46 @@ implementation
end;
function tabstractuniTSymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
var
hsym : tsym;
begin
result:=false;
hsym:=tsym(FindWithHash(hashedid));
if assigned(hsym) then
begin
if hsym.typ=symconst.namespacesym then
begin
case sym.typ of
symconst.namespacesym:;
symconst.unitsym:
begin
HideSym(sym); { if we add a unit and there is a namespace with the same name then hide the unit name and not the namespace }
tnamespacesym(hsym).unitsym:=tsym(sym);
end
else
HideSym(hsym);
end;
end
else
{ In delphi (contrary to TP) you can have a symbol with the same name as the
unit, the unit can then not be accessed anymore using
<unit>.<id>, so we can hide the symbol.
Do the same if we add a namespace and there is a unit with the same name }
if (hsym.typ=symconst.unitsym) and
((m_delphi in current_settings.modeswitches) or (sym.typ=symconst.namespacesym)) then
begin
HideSym(hsym);
if sym.typ=symconst.namespacesym then
tnamespacesym(sym).unitsym:=tsym(hsym);
end
else
DuplicateSym(hashedid,sym,hsym);
result:=true;
exit;
end;
end;
function tabstractuniTSymtable.iscurrentunit:boolean;
begin
result:=assigned(current_module) and
@ -1469,6 +1511,29 @@ implementation
);
end;
procedure tabstractuniTSymtable.insertunit(sym:TSymEntry);
var
p:integer;
n,ns:string;
oldsym:TSymEntry;
begin
insert(sym);
n:=sym.realname;
p:=pos('.',n);
ns:='';
while p>0 do
begin
if ns='' then
ns:=copy(n,1,p-1)
else
ns:=ns+'.'+copy(n,1,p-1);
system.delete(n,1,p);
oldsym:=Find(upper(ns));
if not Assigned(oldsym) or (oldsym.typ<>namespacesym) then
insert(tnamespacesym.create(ns));
p:=pos('.',n);
end;
end;
{****************************************************************************
TStaticSymtable
@ -1501,23 +1566,10 @@ implementation
var
hsym : tsym;
begin
result:=false;
hsym:=tsym(FindWithHash(hashedid));
if assigned(hsym) then
begin
{ Delphi (contrary to TP) you can have a symbol with the same name as the
unit, the unit can then not be accessed anymore using
<unit>.<id>, so we can hide the symbol }
if (m_delphi in current_settings.modeswitches) and
(hsym.typ=symconst.unitsym) then
HideSym(hsym)
else
DuplicateSym(hashedid,sym,hsym);
result:=true;
exit;
end;
result:=inherited checkduplicate(hashedid,sym);
if (current_module.localsymtable=self) and
if not result and
(current_module.localsymtable=self) and
assigned(current_module.globalsymtable) then
result:=tglobalsymtable(current_module.globalsymtable).checkduplicate(hashedid,sym);
end;
@ -1551,28 +1603,6 @@ implementation
end;
function tglobalsymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
var
hsym : tsym;
begin
result:=false;
hsym:=tsym(FindWithHash(hashedid));
if assigned(hsym) then
begin
{ Delphi (contrary to TP) you can have a symbol with the same name as the
unit, the unit can then not be accessed anymore using
<unit>.<id>, so we can hide the symbol }
if (m_delphi in current_settings.modeswitches) and
(hsym.typ=symconst.unitsym) then
HideSym(hsym)
else
DuplicateSym(hashedid,sym,hsym);
result:=true;
exit;
end;
end;
{****************************************************************************
TWITHSYMTABLE
****************************************************************************}

7
compiler/utils/ppudump.pp
View File

@ -1489,6 +1489,13 @@ begin
ibunitsym :
readcommonsym('Unit symbol ');
ibnamespacesym :
begin
readcommonsym('NameSpace symbol ');
write(space,' Hidden Unit : ');
readderef('');
end;
iblabelsym :
readcommonsym('Label symbol ');