Browse Source

* fixed searching for the 8-character variant of already compiled
unit files (patch by Aleksa Todorovic, mantis #17907)

git-svn-id: trunk@16329 -

Jonas Maebe 14 năm trước cách đây
mục cha
commit
de51c4734c

+ 4 - 0
.gitattributes

@@ -10742,6 +10742,10 @@ tests/webtbs/tw1779.pp svneol=native#text/plain
 tests/webtbs/tw1780.pp svneol=native#text/plain
 tests/webtbs/tw17836.pp svneol=native#text/plain
 tests/webtbs/tw17862.pp svneol=native#text/plain
+tests/webtbs/tw17907/main/main.pas svneol=native#text/plain
+tests/webtbs/tw17907/test.bat svneol=native#text/plain
+tests/webtbs/tw17907/unit1/unit0001.pas svneol=native#text/plain
+tests/webtbs/tw17907/unit2/unit0002.pas svneol=native#text/plain
 tests/webtbs/tw1792.pp svneol=native#text/plain
 tests/webtbs/tw1792a.pp svneol=native#text/plain
 tests/webtbs/tw1798.pp svneol=native#text/plain

+ 18 - 16
compiler/fppu.pas

@@ -71,6 +71,7 @@ interface
            avoid endless resolving loops in case of cyclic dependencies. }
           defsgeneration : longint;
 
+          function  search_unit_files(onlysource:boolean):boolean;
           function  search_unit(onlysource,shortname:boolean):boolean;
           procedure load_interface;
           procedure load_implementation;
@@ -259,6 +260,21 @@ var
       end;
 
 
+    function tppumodule.search_unit_files(onlysource:boolean):boolean;
+      var
+        found : boolean;
+      begin
+        found:=false;
+        if search_unit(onlysource,false) then
+          found:=true;
+        if (not found) and
+           (length(modulename^)>8) and
+           search_unit(onlysource,true) then
+          found:=true;
+        search_unit_files:=found;
+      end;
+
+
     function tppumodule.search_unit(onlysource,shortname:boolean):boolean;
       var
          singlepathstring,
@@ -421,18 +437,6 @@ var
            fnd:=SearchPathList(loaded_from.LocalUnitSearchPath);
          if not fnd then
            fnd:=SearchPathList(UnitSearchPath);
-
-         { try to find a file with the first 8 chars of the modulename, like
-           dos }
-         if (not fnd) and (length(filename)>8) then
-          begin
-            filename:=copy(filename,1,8);
-            fnd:=SearchPath('.');
-            if (not fnd) then
-             fnd:=SearchPathList(LocalUnitSearchPath);
-            if not fnd then
-             fnd:=SearchPathList(UnitSearchPath);
-          end;
          search_unit:=fnd;
       end;
 
@@ -1579,7 +1583,7 @@ var
            if not do_compile then
             begin
               Message1(unit_u_loading_unit,modulename^);
-              search_unit(false,false);
+              search_unit_files(false);
               if not do_compile then
                begin
                  load_interface;
@@ -1606,9 +1610,7 @@ var
               { recompile the unit or give a fatal error if sources not available }
               if not(sources_avail) then
                begin
-                 if (not search_unit(true,false)) and
-                    (length(modulename^)>8) then
-                   search_unit(true,true);
+                 search_unit_files(true);
                  if not(sources_avail) then
                   begin
                     printcomments;

+ 7 - 0
tests/webtbs/tw17907/main/main.pas

@@ -0,0 +1,7 @@
+program main;
+
+uses unit0001;
+
+begin
+  p1;
+end.

+ 5 - 0
tests/webtbs/tw17907/test.bat

@@ -0,0 +1,5 @@
+set FPC=fpcpp
+rmdir /s /q units
+mkdir units
+call %FPC% -FUunits -Fuunit1 -Fuunit2 main/main
+call %FPC% -FUunits main/main

+ 17 - 0
tests/webtbs/tw17907/unit1/unit0001.pas

@@ -0,0 +1,17 @@
+unit unit0001;
+
+interface
+
+procedure p1;
+
+implementation
+
+uses
+  unit0002a;
+
+procedure p1;
+begin
+  p2;
+end;
+
+end.

+ 14 - 0
tests/webtbs/tw17907/unit2/unit0002.pas

@@ -0,0 +1,14 @@
+unit unit0002a;
+
+interface
+
+procedure p2;
+
+implementation
+
+procedure p2;
+begin
+  Writeln('main -> p1 -> p2');
+end;
+
+end.