paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-10 06:18:53 +02:00
Code Issues Packages Projects Releases Wiki Activity

* support uses <unit> in <file> construction

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
compiler/fppu.pas
View File

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

7
compiler/parser.pas
View File

@ -383,7 +383,7 @@ implementation
end end
else else
begin begin
current_module:=tppumodule.create(filename,false); current_module:=tppumodule.create(filename,'',false);
main_module:=current_module; main_module:=current_module;
end; end;
@ -617,7 +617,10 @@ implementation
end. end.
{ {
$Log$ $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 * ppu object to class rewrite
* move ppu read and write stuff to fppu * move ppu read and write stuff to fppu

32
compiler/pmodules.pas
View File

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