Simba: INCLUDE_ONCE and INCLUDE fixes.

This commit is contained in:
Merlijn Wajer 2011-07-31 16:49:16 +02:00
parent 00531f5e4a
commit b301172600
3 changed files with 55 additions and 3 deletions

View File

@ -185,6 +185,7 @@ type
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;
procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler);
procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
@ -425,7 +426,9 @@ begin
Exit;
end;
filename := path;//Yeah!
Includes.Add(path);
if Includes.IndexOf(path) = -1 then
Includes.Add(path);
try
f:= TFileStream.Create(UTF8ToSys(Path), fmOpenRead);
@ -615,6 +618,7 @@ begin
PSScript.UsePreProcessor:= True;
PSScript.CompilerOptions := PSScript.CompilerOptions + [icBooleanShortCircuit];
PSScript.OnNeedFile := @RequireFile;
PSScript.OnIncludingFile := @OnIncludingFile;
PSScript.OnFileAlreadyIncluded := @FileAlreadyIncluded;
PSScript.OnProcessDirective:=@OnProcessDirective;
PSScript.OnProcessUnknowDirective:=@PSScriptProcessUnknownDirective;
@ -742,9 +746,12 @@ var
path: string;
i: integer;
begin
{ XXX/TODO: Why not just use path := ExpandFileNameUTF8(FileName); }
path := FindFile(Filename,[ScriptPath,IncludePath]);
path := ExpandFileNameUTF8(path);
if (path <> '') then
if Includes.Find(path,i) then
if Includes.IndexOf(path) <> -1 then
begin
{$IFDEF SIMBA_VERBOSE}
psWriteln('Include_Once file already included:' + Path);
@ -753,10 +760,31 @@ begin
Exit;
end;
{$IFDEF SIMBA_VERBOSE}
writeln('OnFileAlreadyIncluded, Adding: ' + path);
{$ENDIF}
Includes.Add(path);
Result := False;
end;
function TPSThread.OnIncludingFile(Sender: TObject; FileName: string): Boolean;
var
path: string;
begin
path := FindFile(Filename,[ScriptPath,IncludePath]);
path := ExpandFileNameUTF8(path);
if Includes.IndexOf(path) = -1 then
begin
{$IFDEF SIMBA_VERBOSE}
writeln('OnIncludingFile, Adding: ' + path);
{$ENDIF}
Includes.Add(path);
end;
Result := True; // Not used
end;
procedure SIRegister_Mufasa(cl: TPSPascalCompiler);
begin
SIRegister_MML(cl);

View File

@ -95,6 +95,7 @@ type
{ Added by Wizzup }
TPSOnFileAlreadyIncluded = function (Sender: TObject; FileName: tbtstring): Boolean of object;
TPSOnIncludingFile = function (Sender: TObject; FileName: tbtstring): Boolean of object;
{ Wizzup out }
TPSOnProcessDirective = procedure (
@ -127,6 +128,7 @@ type
FOnNeedFile: TPSOnNeedFile;
{ Added by Wizzup }
FOnFileAlreadyIncluded: TPSOnFileAlreadyIncluded;
FOnIncludingFile: TPSOnIncludingFile;
{ Wizzup out }
FUsePreProcessor: Boolean;
FDefines: TStrings;
@ -162,6 +164,7 @@ type
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;
{ Wizzup out }
function DoOnUnknowUses (Sender: TPSPascalCompiler; const Name: tbtstring): Boolean; virtual; // return true if processed
procedure DoOnCompImport; virtual;
@ -300,6 +303,7 @@ type
{ Added by Wizzup }
property OnFileAlreadyIncluded: TPSOnFileAlreadyIncluded read FOnFileAlreadyIncluded write FOnFileAlreadyIncluded;
property OnIncludingFile: TPSOnIncludingFile read FOnIncludingFile write FOnIncludingFile;
{ Wizzup out }
property Defines: TStrings read FDefines write SetDefines;
@ -557,6 +561,11 @@ function CEOnFileAlreadyIncluded(Sender: TPSPreProcessor; FileName: tbtstring):
begin
Result := TPSScript (Sender.ID).DoOnFileAlreadyIncluded(Sender.ID, Filename);
end;
function CEOnIncludingFile(Sender: TPSPreProcessor; FileName: tbtstring): Boolean;
begin
Result := TPSScript (Sender.ID).DoOnIncludingFile(Sender.ID, Filename);
end;
{ Wizzup out }
procedure CompTranslateLineInfo(Sender: TPSPascalCompiler; var Pos, Row, Col: Cardinal; var Name: tbtstring);
@ -675,6 +684,7 @@ begin
{ Added by Wizzup }
FPP.OnFileAlreadyIncluded:= CEOnFileAlreadyIncluded;
FPP.OnIncludingFile:= CEOnIncludingFile;
{ Wizzup out }
FDefines := TStringList.Create;
@ -1088,6 +1098,15 @@ begin
else
Result := False;
end;
function TPSScript.DoOnIncludingFile(Sender: TObject;
FileName: tbtstring): Boolean;
begin
If Assigned (OnIncludingFile) then
Result := OnIncludingFile(Sender, FileName)
else
Result := False;
end;
{ Wizzup out }
function TPSScript.DoOnUnknowUses(Sender: TPSPascalCompiler;

View File

@ -17,6 +17,7 @@ type
{ Added by Wizzup }
TPSOnFileAlreadyIncluded = function (Sender: TPSPreProcessor; FileName: tbtstring): Boolean;
TPSOnIncludingFile = function (Sender: TPSPreProcessor; FileName: tbtstring): Boolean;
{ Wizzup out }
TPSOnProcessDirective = procedure (
@ -99,6 +100,7 @@ type
FOnNeedFile: TPSOnNeedFile;
{ Added by Wizzup }
FOnFileAlreadyIncluded: TPSOnFileAlreadyIncluded;
FOnIncludingFile: TPSOnIncludingFile;
{ Wizzup out }
FAddedPosition: Cardinal;
FDefineState: TPSDefineStates;
@ -120,6 +122,7 @@ type
{ Added by Wizzup }
property OnFileAlreadyIncluded: TPSOnFileAlreadyIncluded read FOnFileAlreadyIncluded write FOnFileAlreadyIncluded;
property OnIncludingFile: TPSOnIncludingFile read FOnIncludingFile write FOnIncludingFile;
{ Wizzup out }
property Defines: TStringList read FDefines write FDefines;
@ -633,6 +636,8 @@ begin
begin
if FDefineState.DoWrite then
begin
if assigned(@OnIncludingFile) then
OnIncludingFile(self, s);
FAddedPosition := 0;
IntPreProcess(Level +1, FileName, s, Dest);
FCurrentLineInfo.Current := current;
@ -646,7 +651,7 @@ begin
raise EPSPreProcessor.CreateFmt(RPS_IncludeOnceNotFound, [FileName, OrgFileName])
else
begin
if not OnFileAlreadyIncluded(Self, FileName) then
if not OnFileAlreadyIncluded(Self, s) then
begin
FAddedPosition := 0;
IntPreProcess(Level +1, FileName, s, Dest);