* support uses <unit> in <file> construction

This commit is contained in:
peter 2001-05-19 23:05:19 +00:00
parent 26571c051c
commit 6e65cd0ee4
3 changed files with 71 additions and 30 deletions

View File

@ -49,11 +49,11 @@ interface
crc_array2 : pointer;
crc_size2 : longint;
{$endif def Test_Double_checksum}
constructor create(const s:string;_is_unit:boolean);
constructor create(const s:string;const fn:string;_is_unit:boolean);
destructor destroy;override;
procedure reset;override;
function openppu:boolean;
function search_unit(const n : string;onlysource:boolean):boolean;
function search_unit(const n : string;const fn:string;onlysource:boolean):boolean;
procedure getppucrc;
procedure writeppu;
procedure loadppu;
@ -73,7 +73,7 @@ interface
end;
function loadunit(const s : stringid) : tmodule;
function loadunit(const s : stringid;const fn:string) : tmodule;
implementation
@ -94,7 +94,7 @@ uses
TPPUMODULE
****************************************************************************}
constructor tppumodule.create(const s:string;_is_unit:boolean);
constructor tppumodule.create(const s:string;const fn:string;_is_unit:boolean);
begin
inherited create(s,_is_unit);
ppufile:=nil;
@ -103,7 +103,7 @@ uses
begin
{ use the realmodulename so we can also find a case sensitive
source filename }
search_unit(realmodulename^,false);
search_unit(realmodulename^,fn,false);
{ it the sources_available is changed then we know that
the sources aren't available }
if not sources_avail then
@ -198,7 +198,7 @@ uses
end;
function tppumodule.search_unit(const n : string;onlysource:boolean):boolean;
function tppumodule.search_unit(const n : string;const fn:string;onlysource:boolean):boolean;
var
singlepathstring,
filename : string;
@ -289,14 +289,16 @@ uses
var
fnd : boolean;
hs : string;
begin
filename:=FixFileName(n);
{ try to find unit
1. look for ppu in cwd
2. look for ppu in outputpath if set, this is tp7 compatible (PFV)
3. look for source in cwd
4. local unit pathlist
5. global unit pathlist }
3. look for the specified source file (from the uses line)
4. look for source in cwd
5. local unit pathlist
6. global unit pathlist }
fnd:=false;
if not onlysource then
begin
@ -304,6 +306,27 @@ uses
if (not fnd) and (current_module.outputpath^<>'') then
fnd:=PPUSearchPath(current_module.outputpath^);
end;
if (not fnd) and (fn<>'') then
begin
{ the full filename is specified so we can't use here the
searchpath (PFV) }
Message1(unit_t_unitsearch,AddExtension(fn,target_info.sourceext));
fnd:=FindFile(AddExtension(fn,target_info.sourceext),'',hs);
if not fnd then
begin
Message1(unit_t_unitsearch,AddExtension(fn,target_info.pasext));
fnd:=FindFile(AddExtension(fn,target_info.pasext),'',hs);
end;
if fnd then
begin
sources_avail:=true;
do_compile:=true;
recompile_reason:=rr_noppu;
stringdispose(mainsource);
mainsource:=StringDup(hs);
SetFileName(hs,false);
end;
end;
if (not fnd) then
fnd:=SourceSearchPath('.');
if (not fnd) then
@ -853,7 +876,7 @@ uses
begin
if (not pu.loaded) and (pu.in_interface) then
begin
loaded_unit:=loadunit(pu.name^);
loaded_unit:=loadunit(pu.name^,'');
if compiled then
exit;
{ register unit in used units }
@ -895,7 +918,7 @@ uses
begin
if (not pu.loaded) and (not pu.in_interface) then
begin
loaded_unit:=loadunit(pu.name^);
loaded_unit:=loadunit(pu.name^,'');
if compiled then
exit;
{ register unit in used units }
@ -962,9 +985,9 @@ uses
{ recompile the unit or give a fatal error if sources not available }
if not(sources_avail) and
not(sources_checked) then
if (not search_unit(modulename^,true))
if (not search_unit(modulename^,'',true))
and (length(modulename^)>8) then
search_unit(copy(modulename^,1,8),true);
search_unit(copy(modulename^,1,8),'',true);
if not(sources_avail) then
begin
if recompile_reason=rr_noppu then
@ -1004,7 +1027,7 @@ uses
LoadUnit
*****************************************************************************}
function loadunit(const s : stringid) : tmodule;
function loadunit(const s : stringid;const fn:string) : tmodule;
const
ImplIntf : array[boolean] of string[15]=('interface','implementation');
var
@ -1086,7 +1109,7 @@ uses
hp.reset;
hp.scanner:=scanner;
{ try to reopen ppu }
hp.search_unit(s,false);
hp.search_unit(s,fn,false);
{ try to load the unit a second time first }
current_module:=hp;
current_module.in_second_load:=true;
@ -1096,7 +1119,7 @@ uses
else
{ generates a new unit info record }
begin
current_module:=tppumodule.create(s,true);
current_module:=tppumodule.create(s,fn,true);
scanner:=nil;
second_time:=false;
end;
@ -1125,7 +1148,7 @@ uses
while assigned(hp2) do
begin
if hp2.do_reload then
dummy:=loadunit(hp2.modulename^);
dummy:=loadunit(hp2.modulename^,'');
hp2:=tmodule(hp2.next);
end;
end
@ -1149,7 +1172,10 @@ uses
end.
{
$Log$
Revision 1.6 2001-05-19 21:08:59 peter
Revision 1.7 2001-05-19 23:05:19 peter
* support uses <unit> in <file> construction
Revision 1.6 2001/05/19 21:08:59 peter
* skip program when checking loaded_units for a unit
Revision 1.5 2001/05/19 13:22:47 peter

View File

@ -383,7 +383,7 @@ implementation
end
else
begin
current_module:=tppumodule.create(filename,false);
current_module:=tppumodule.create(filename,'',false);
main_module:=current_module;
end;
@ -617,7 +617,10 @@ implementation
end.
{
$Log$
Revision 1.18 2001-05-06 14:49:17 peter
Revision 1.19 2001-05-19 23:05:19 peter
* support uses <unit> in <file> construction
Revision 1.18 2001/05/06 14:49:17 peter
* ppu object to class rewrite
* move ppu read and write stuff to fppu

View File

@ -52,7 +52,7 @@ implementation
{$ifdef GDB}
gdb,
{$endif GDB}
scanner,pbase,psystem,psub,parser;
scanner,pbase,pexpr,psystem,psub,parser;
procedure create_objectfile;
var
@ -352,7 +352,7 @@ implementation
exit;
end;
{ insert the system unit, it is allways the first }
hp:=loadunit('System');
hp:=loadunit('System','');
systemunit:=tglobalsymtable(hp.globalsymtable);
{ it's always the first unit }
systemunit.next:=nil;
@ -369,7 +369,7 @@ implementation
{ Objpas unit? }
if m_objpas in aktmodeswitches then
begin
hp:=loadunit('ObjPas');
hp:=loadunit('ObjPas','');
tsymtable(hp.globalsymtable).next:=symtablestack;
symtablestack:=hp.globalsymtable;
{ add to the used units }
@ -381,7 +381,7 @@ implementation
{ Profile unit? Needed for go32v2 only }
if (cs_profile in aktmoduleswitches) and (target_info.target=target_i386_go32v2) then
begin
hp:=loadunit('Profile');
hp:=loadunit('Profile','');
tsymtable(hp.globalsymtable).next:=symtablestack;
symtablestack:=hp.globalsymtable;
{ add to the used units }
@ -396,7 +396,7 @@ implementation
{ Heaptrc unit }
if (cs_gdb_heaptrc in aktglobalswitches) then
begin
hp:=loadunit('HeapTrc');
hp:=loadunit('HeapTrc','');
tsymtable(hp.globalsymtable).next:=symtablestack;
symtablestack:=hp.globalsymtable;
{ add to the used units }
@ -408,7 +408,7 @@ implementation
{ Lineinfo unit }
if (cs_gdb_lineinfo in aktglobalswitches) then
begin
hp:=loadunit('LineInfo');
hp:=loadunit('LineInfo','');
tsymtable(hp.globalsymtable).next:=symtablestack;
symtablestack:=hp.globalsymtable;
{ add to the used units }
@ -426,6 +426,7 @@ implementation
procedure loadunits;
var
s,sorg : stringid;
fn : string;
pu,
hp : tused_unit;
hp2 : tmodule;
@ -442,10 +443,18 @@ implementation
s:=pattern;
sorg:=orgpattern;
consume(_ID);
{ Give a warning if objpas is loaded }
{ support "<unit> in '<file>'" construct, but not for tp7 }
if not(m_tp7 in aktmodeswitches) then
begin
if try_to_consume(_OP_IN) then
fn:=get_stringconst
else
fn:='';
end;
{ Give a warning if objpas is loaded }
if s='OBJPAS' then
Message(parser_w_no_objpas_use_mode);
{ check if the unit is already used }
{ check if the unit is already used }
pu:=tused_unit(current_module.used_units.first);
while assigned(pu) do
begin
@ -457,7 +466,7 @@ implementation
if not assigned(pu) and (s<>current_module.modulename^) then
begin
{ load the unit }
hp2:=loadunit(sorg);
hp2:=loadunit(sorg,fn);
{ the current module uses the unit hp2 }
current_module.used_units.concat(tused_unit.create(hp2,not current_module.in_implementation));
tused_unit(current_module.used_units.last).in_uses:=true;
@ -1307,7 +1316,10 @@ implementation
end.
{
$Log$
Revision 1.32 2001-05-18 22:26:36 peter
Revision 1.33 2001-05-19 23:05:19 peter
* support uses <unit> in <file> construction
Revision 1.32 2001/05/18 22:26:36 peter
* merged alignment for non-i386
Revision 1.31 2001/05/09 14:11:10 jonas