Răsfoiți Sursa

Add code which tries to load a unit from a package first and only then as usual.

fppu.pas, tppumodule:
  + new method loadfrompackage which searches all available packages for the unit and loads it from there if found
  * loadppu: first try to load the unit from a package if any are available

git-svn-id: branches/svenbarth/packages@28850 -
svenbarth 11 ani în urmă
părinte
comite
37166976b4
1 a modificat fișierele cu 92 adăugiri și 1 ștergeri
  1. 92 1
      compiler/fppu.pas

+ 92 - 1
compiler/fppu.pas

@@ -76,6 +76,7 @@ interface
 
           function  search_unit_files(onlysource:boolean):boolean;
           function  search_unit(onlysource,shortname:boolean):boolean;
+          function  loadfrompackage:boolean;
           procedure load_interface;
           procedure load_implementation;
           procedure load_usedunits;
@@ -124,7 +125,7 @@ uses
   aasmbase,ogbase,
   parser,
   comphook,
-  entfile;
+  entfile,fpkg;
 
 
 var
@@ -486,6 +487,86 @@ var
          search_unit:=fnd;
       end;
 
+    function tppumodule.loadfrompackage: boolean;
+      var
+        singlepathstring,
+        filename : TCmdStr;
+
+        Function UnitExists(const ext:string;var foundfile:TCmdStr):boolean;
+          begin
+            if CheckVerbosity(V_Tried) then
+              Message1(unit_t_unitsearch,Singlepathstring+filename);
+            UnitExists:=FindFile(FileName,Singlepathstring,true,foundfile);
+          end;
+
+        Function PPUSearchPath(const s:TCmdStr):boolean;
+          var
+            found : boolean;
+            hs    : TCmdStr;
+          begin
+            Found:=false;
+            singlepathstring:=FixPath(s,false);
+          { Check for PPU file }
+            Found:=UnitExists(target_info.unitext,hs);
+            if Found then
+             Begin
+               SetFileName(hs,false);
+               Found:=OpenPPU;
+             End;
+            PPUSearchPath:=Found;
+          end;
+
+        Function SearchPathList(list:TSearchPathList):boolean;
+          var
+            hp : TCmdStrListItem;
+            found : boolean;
+          begin
+            found:=false;
+            hp:=TCmdStrListItem(list.First);
+            while assigned(hp) do
+             begin
+               found:=PPUSearchPath(hp.Str);
+               if found then
+                break;
+               hp:=TCmdStrListItem(hp.next);
+             end;
+            SearchPathList:=found;
+          end;
+
+      var
+        pkg : ppackageentry;
+        pkgunit : pcontainedunit;
+        i,idx : longint;
+      begin
+        result:=false;
+        for i:=0 to packagelist.count-1 do
+          begin
+            pkg:=ppackageentry(packagelist[i]);
+            if not assigned(pkg^.package) then
+              internalerror(2013053103);
+            idx:=pkg^.package.containedmodules.FindIndexOf(modulename^);
+            if idx>=0 then
+              begin
+                { the unit is part of this package }
+                pkgunit:=pcontainedunit(pkg^.package.containedmodules[idx]);
+                if not assigned(pkgunit^.module) then
+                  pkgunit^.module:=self;
+                filename:=pkgunit^.ppufile;
+                if not SearchPathList(unitsearchpath) then
+                  exit;
+
+                { now load the unit and all used units }
+                load_interface;
+                setdefgeneration;
+                load_usedunits;
+                Message1(unit_u_finished_loading_unit,modulename^);
+
+                result:=true;
+                break;
+              end;
+          end;
+      end;
+
 
 {**********************************
     PPU Reading/Writing Helpers
@@ -1698,6 +1779,16 @@ var
         second_time:=false;
         set_current_module(self);
 
+        { try to load it as a package unit first }
+        if (packagelist.count>0) and loadfrompackage then
+          begin
+            do_load:=false;
+            do_reload:=false;
+            state:=ms_load;
+            { add the unit to the used units list of the program }
+            usedunits.concat(tused_unit.create(self,true,false,nil));
+          end;
+
         { A force reload }
         if do_reload then
          begin