mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 11:09:42 +02:00
* support uses <unit> in <file> construction
This commit is contained in:
parent
26571c051c
commit
6e65cd0ee4
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user