mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 17:59:27 +02:00
* fixed searching for the 8-character variant of already compiled
unit files (patch by Aleksa Todorovic, mantis #17907) git-svn-id: trunk@16329 -
This commit is contained in:
parent
44dc6e7283
commit
de51c4734c
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -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
|
||||
|
@ -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
tests/webtbs/tw17907/main/main.pas
Normal file
7
tests/webtbs/tw17907/main/main.pas
Normal file
@ -0,0 +1,7 @@
|
||||
program main;
|
||||
|
||||
uses unit0001;
|
||||
|
||||
begin
|
||||
p1;
|
||||
end.
|
5
tests/webtbs/tw17907/test.bat
Normal file
5
tests/webtbs/tw17907/test.bat
Normal file
@ -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
tests/webtbs/tw17907/unit1/unit0001.pas
Normal file
17
tests/webtbs/tw17907/unit1/unit0001.pas
Normal file
@ -0,0 +1,17 @@
|
||||
unit unit0001;
|
||||
|
||||
interface
|
||||
|
||||
procedure p1;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
unit0002a;
|
||||
|
||||
procedure p1;
|
||||
begin
|
||||
p2;
|
||||
end;
|
||||
|
||||
end.
|
14
tests/webtbs/tw17907/unit2/unit0002.pas
Normal file
14
tests/webtbs/tw17907/unit2/unit0002.pas
Normal file
@ -0,0 +1,14 @@
|
||||
unit unit0002a;
|
||||
|
||||
interface
|
||||
|
||||
procedure p2;
|
||||
|
||||
implementation
|
||||
|
||||
procedure p2;
|
||||
begin
|
||||
Writeln('main -> p1 -> p2');
|
||||
end;
|
||||
|
||||
end.
|
Loading…
Reference in New Issue
Block a user