浏览代码

* support uses <unit> in <file> construction

peter 24 年之前
父节点
当前提交
6e65cd0ee4
共有 3 个文件被更改,包括 71 次插入30 次删除
  1. 44 18
      compiler/fppu.pas
  2. 5 2
      compiler/parser.pas
  3. 22 10
      compiler/pmodules.pas

+ 44 - 18
compiler/fppu.pas

@@ -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
-            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;
          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

+ 5 - 2
compiler/parser.pas

@@ -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
 
 

+ 22 - 10
compiler/pmodules.pas

@@ -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