Simba: Fix recursive INCLUDE_ONCE.

This commit is contained in:
Merlijn Wajer 2011-07-31 17:36:34 +02:00
parent b301172600
commit cf41d95f53
3 changed files with 33 additions and 24 deletions

View File

@ -184,8 +184,8 @@ type
procedure OnCompile(Sender: TPSScript);
function RequireFile(Sender: TObject; const OriginFileName: String;
var FileName, OutPut: string): Boolean;
function FileAlreadyIncluded(Sender: TObject; FileName: string): Boolean;
function OnIncludingFile(Sender: TObject; FileName: string): Boolean;
function FileAlreadyIncluded(Sender: TObject; OrgFileName, FileName: string): Boolean;
function OnIncludingFile(Sender: TObject; OrgFileName, FileName: string): Boolean;
procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler);
procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
@ -741,20 +741,24 @@ begin
'{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}';
end;
function TPSThread.FileAlreadyIncluded(Sender: TObject; FileName: string): Boolean;
function TPSThread.FileAlreadyIncluded(Sender: TObject; OrgFileName, FileName: string): Boolean;
var
path: string;
i: integer;
begin
{ XXX/TODO: Why not just use path := ExpandFileNameUTF8(FileName); }
path := FindFile(Filename,[ScriptPath,IncludePath]);
path := FindFile(filename,[includepath,ScriptPath,IncludeTrailingPathDelimiter(ExtractFileDir(OrgFileName))]);
if path = '' then
begin
Result := True;
Exit;
end;
path := ExpandFileNameUTF8(path);
if (path <> '') then
if Includes.IndexOf(path) <> -1 then
begin
{$IFDEF SIMBA_VERBOSE}
psWriteln('Include_Once file already included:' + Path);
writeln('Include_Once file already included:' + Path);
{$ENDIF}
Result := True;
Exit;
@ -767,11 +771,16 @@ begin
Result := False;
end;
function TPSThread.OnIncludingFile(Sender: TObject; FileName: string): Boolean;
function TPSThread.OnIncludingFile(Sender: TObject; OrgFileName, FileName: string): Boolean;
var
path: string;
begin
path := FindFile(Filename,[ScriptPath,IncludePath]);
path := FindFile(filename,[includepath,ScriptPath,IncludeTrailingPathDelimiter(ExtractFileDir(OrgFileName))]);
if path = '' then
begin
Result := True;
Exit;
end;
path := ExpandFileNameUTF8(path);
if Includes.IndexOf(path) = -1 then

View File

@ -94,8 +94,8 @@ type
TPSOnNeedFile = function (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean of object;
{ Added by Wizzup }
TPSOnFileAlreadyIncluded = function (Sender: TObject; FileName: tbtstring): Boolean of object;
TPSOnIncludingFile = function (Sender: TObject; FileName: tbtstring): Boolean of object;
TPSOnFileAlreadyIncluded = function (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean of object;
TPSOnIncludingFile = function (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean of object;
{ Wizzup out }
TPSOnProcessDirective = procedure (
@ -163,8 +163,8 @@ type
//--jgv new
function DoOnNeedFile (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean; virtual;
{ Added by Wizzup }
function DoOnFileAlreadyIncluded (Sender: TObject; FileName: tbtstring): Boolean; virtual;
function DoOnIncludingFile (Sender: TObject; FileName: tbtstring): Boolean; virtual;
function DoOnFileAlreadyIncluded (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean; virtual;
function DoOnIncludingFile (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean; virtual;
{ Wizzup out }
function DoOnUnknowUses (Sender: TPSPascalCompiler; const Name: tbtstring): Boolean; virtual; // return true if processed
procedure DoOnCompImport; virtual;
@ -557,14 +557,14 @@ begin
end;
{ Added by Wizzup }
function CEOnFileAlreadyIncluded(Sender: TPSPreProcessor; FileName: tbtstring): Boolean;
function CEOnFileAlreadyIncluded(Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean;
begin
Result := TPSScript (Sender.ID).DoOnFileAlreadyIncluded(Sender.ID, Filename);
Result := TPSScript (Sender.ID).DoOnFileAlreadyIncluded(Sender.ID, OrgFileName, Filename);
end;
function CEOnIncludingFile(Sender: TPSPreProcessor; FileName: tbtstring): Boolean;
function CEOnIncludingFile(Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean;
begin
Result := TPSScript (Sender.ID).DoOnIncludingFile(Sender.ID, Filename);
Result := TPSScript (Sender.ID).DoOnIncludingFile(Sender.ID, OrgFileName, Filename);
end;
{ Wizzup out }
@ -1091,19 +1091,19 @@ end;
{ Added by Wizzup }
function TPSScript.DoOnFileAlreadyIncluded(Sender: TObject;
FileName: tbtstring): Boolean;
OrgFileName, FileName: tbtstring): Boolean;
begin
If Assigned (OnFileAlreadyIncluded) then
Result := OnFileAlreadyIncluded(Sender, FileName)
Result := OnFileAlreadyIncluded(Sender, OrgFileName, FileName)
else
Result := False;
end;
function TPSScript.DoOnIncludingFile(Sender: TObject;
FileName: tbtstring): Boolean;
OrgFileName, FileName: tbtstring): Boolean;
begin
If Assigned (OnIncludingFile) then
Result := OnIncludingFile(Sender, FileName)
Result := OnIncludingFile(Sender, OrgFileName, FileName)
else
Result := False;
end;

View File

@ -16,8 +16,8 @@ type
TPSOnNeedFile = function (Sender: TPSPreProcessor; const callingfilename: tbtstring; var FileName, Output: tbtstring): Boolean;
{ Added by Wizzup }
TPSOnFileAlreadyIncluded = function (Sender: TPSPreProcessor; FileName: tbtstring): Boolean;
TPSOnIncludingFile = function (Sender: TPSPreProcessor; FileName: tbtstring): Boolean;
TPSOnFileAlreadyIncluded = function (Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean;
TPSOnIncludingFile = function (Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean;
{ Wizzup out }
TPSOnProcessDirective = procedure (
@ -637,7 +637,7 @@ begin
if FDefineState.DoWrite then
begin
if assigned(@OnIncludingFile) then
OnIncludingFile(self, s);
OnIncludingFile(self , Filename, s);
FAddedPosition := 0;
IntPreProcess(Level +1, FileName, s, Dest);
FCurrentLineInfo.Current := current;
@ -651,7 +651,7 @@ begin
raise EPSPreProcessor.CreateFmt(RPS_IncludeOnceNotFound, [FileName, OrgFileName])
else
begin
if not OnFileAlreadyIncluded(Self, s) then
if not OnFileAlreadyIncluded(Self, FileName, s) then
begin
FAddedPosition := 0;
IntPreProcess(Level +1, FileName, s, Dest);