moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-21 16:55:01 -05:00
Code Issues Releases Wiki Activity

Simba/PS: Add/Fix include_once support.

Browse Source
This commit is contained in:
Merlijn Wajer 2011-02-19 15:19:08 +01:00
parent 5d90489fd8
commit aac852c18c
3 changed files with 90 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
Units/MMLAddon/mmlpsthread.pas
View File

@ -180,6 +180,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;
procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler);
procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
procedure OutputMessages;
@ -464,9 +466,9 @@ begin
if (path <> '') then
if Includes.Find(path,i) then
begin
psWriteln('Include_Once file already included');
Writeln('include_once: File already included.'); // debug message
Result := False;
end;
end
end;
end else
Result := True;
@ -576,6 +578,7 @@ begin
PSScript.UsePreProcessor:= True;
PSScript.CompilerOptions := PSScript.CompilerOptions + [icBooleanShortCircuit];
PSScript.OnNeedFile := @RequireFile;
PSScript.OnFileAlreadyIncluded := @FileAlreadyIncluded;
PSScript.OnProcessDirective:=@OnProcessDirective;
PSScript.OnProcessUnknowDirective:=@PSScriptProcessUnknowDirective;
PSScript.OnCompile:= @OnCompile;
@ -692,6 +695,22 @@ begin
'{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}';
end;
function TPSThread.FileAlreadyIncluded(Sender: TObject; FileName: string): Boolean;
var
path: string;
i: integer;
begin
path := FindFile(Filename,[ScriptPath,IncludePath]);
if (path <> '') then
if Includes.Find(path,i) then
begin
psWriteln('Include_Once file already included');
Result := False;
end;
Includes.Add(path);
Result := True;
end;
procedure SIRegister_Mufasa(cl: TPSPascalCompiler);
begin
SIRegister_MML(cl);

36
Units/PascalScript/uPSComponent.pas
View File

@ -93,6 +93,10 @@ type
{Script engine event function}
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;
{ Wizzup out }
TPSOnProcessDirective = procedure (
Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser;
@ -120,6 +124,9 @@ type
FPP: TPSPreProcessor;
FMainFileName: tbtstring;
FOnNeedFile: TPSOnNeedFile;
{ Added by Wizzup }
FOnFileAlreadyIncluded: TPSOnFileAlreadyIncluded;
{ Wizzup out }
FUsePreProcessor: Boolean;
FDefines: TStrings;
FOnVerifyProc: TPSVerifyProc;
@ -152,6 +159,9 @@ 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;
{ Wizzup out }
function DoOnUnknowUses (Sender: TPSPascalCompiler; const Name: tbtstring): Boolean; virtual; // return true if processed
procedure DoOnCompImport; virtual;
procedure DoOnCompile; virtual;
@ -285,6 +295,10 @@ type
property OnNeedFile: TPSOnNeedFile read FOnNeedFile write FOnNeedFile;
{ Added by Wizzup }
property OnFileAlreadyIncluded: TPSOnFileAlreadyIncluded read FOnFileAlreadyIncluded write FOnFileAlreadyIncluded;
{ Wizzup out }
property Defines: TStrings read FDefines write SetDefines;
property OnVerifyProc: TPSVerifyProc read FOnVerifyProc write FOnVerifyProc;
@ -535,6 +549,13 @@ begin
Result := TPSScript (Sender.ID).DoOnNeedFile(Sender.ID, CallingFileName, FileName, Output);
end;
{ Added by Wizzup }
function CEOnFileAlreadyIncluded(Sender: TPSPreProcessor; FileName: tbtstring): Boolean;
begin
Result := TPSScript (Sender.ID).DoOnFileAlreadyIncluded(Sender.ID, Filename);
end;
{ Wizzup out }
procedure CompTranslateLineInfo(Sender: TPSPascalCompiler; var Pos, Row, Col: Cardinal; var Name: tbtstring);
var
res: TPSLineInfoResults;
@ -649,6 +670,10 @@ begin
FPP.Id := Self;
FPP.OnNeedFile := CENeedFile;
{ Added by Wizzup }
FPP.OnFileAlreadyIncluded:= CEOnFileAlreadyIncluded;
{ Wizzup out }
FDefines := TStringList.Create;
end;
@ -1049,6 +1074,17 @@ begin
Result := False;
end;
{ Added by Wizzup }
function TPSScript.DoOnFileAlreadyIncluded(Sender: TObject;
FileName: tbtstring): Boolean;
begin
If Assigned (OnFileAlreadyIncluded) then
Result := OnFileAlreadyIncluded(Sender, FileName)
else
Result := False;
end;
{ Wizzup out }
function TPSScript.DoOnUnknowUses(Sender: TPSPascalCompiler;
const Name: tbtstring): Boolean;
var

34
Units/PascalScript/uPSPreProcessor.pas
View File

@ -14,6 +14,11 @@ type
TPSPascalPreProcessorParser = class;
TPSOnNeedFile = function (Sender: TPSPreProcessor; const callingfilename: tbtstring; var FileName, Output: tbtstring): Boolean;
{ Added by Wizzup }
TPSOnFileAlreadyIncluded = function (Sender: TPSPreProcessor; FileName: tbtstring): Boolean;
{ Wizzup out }
TPSOnProcessDirective = procedure (
Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser;
@ -91,6 +96,9 @@ type
FCurrentDefines, FDefines: TStringList;
FCurrentLineInfo: TPSLineInfoList;
FOnNeedFile: TPSOnNeedFile;
{ Added by Wizzup }
FOnFileAlreadyIncluded: TPSOnFileAlreadyIncluded;
{ Wizzup out }
FAddedPosition: Cardinal;
FDefineState: TPSDefineStates;
FMaxLevel: Longint;
@ -109,6 +117,10 @@ type
property OnNeedFile: TPSOnNeedFile read FOnNeedFile write FOnNeedFile;
{ Added by Wizzup }
property OnFileAlreadyIncluded: TPSOnFileAlreadyIncluded read FOnFileAlreadyIncluded write FOnFileAlreadyIncluded;
{ Wizzup out }
property Defines: TStringList read FDefines write FDefines;
property MainFile: tbtstring read FMainFile write FMainFile;
@ -213,6 +225,9 @@ const
RPS_TooManyNestedInclude = 'Too many nested include files while processing ''%s'' from ''%s''';
RPS_IncludeNotFound = 'Unable to find file ''%s'' used from ''%s''';
{ Added by Wizzup }
RPS_IncludeOnceNotFound = 'Unable to check if file ''%s'' is already included, used from ''%s''';
{ Wizzup out }
RPS_DefineTooManyParameters = 'Too many parameters at %d:%d';
RPS_NoIfdefForEndif = 'No IFDEF for ENDIF at %d:%d';
RPS_NoIfdefForElse = 'No IFDEF for ELSE at %d:%d';
@ -614,7 +629,7 @@ begin
If AppContinue then
//-- end jgv
if (Name = 'I') or (Name = 'INCLUDE') or (Name = 'INCLUDE_ONCE') then
if (Name = 'I') or (Name = 'INCLUDE') then
begin
if FDefineState.DoWrite then
begin
@ -623,6 +638,23 @@ begin
FCurrentLineInfo.Current := current;
FAddedPosition := Cardinal(Dest.Position) - Item.StartPos - Parser.Pos;
end;
{ Added by Wizzup }
end else if (Name = 'INCLUDE_ONCE') then
begin
if FDefineState.DoWrite then
if (@OnFileAlreadyIncluded = nil) then
raise EPSPreProcessor.CreateFmt(RPS_IncludeOnceNotFound, [FileName, OrgFileName])
else
begin
if not OnFileAlreadyIncluded(Self, FileName) then
begin
FAddedPosition := 0;
IntPreProcess(Level +1, FileName, s, Dest);
FCurrentLineInfo.Current := current;
FAddedPosition := Cardinal(Dest.Position) - Item.StartPos - Parser.Pos;
end;
end;
{ Wizzup out }
end else if (Name = 'DEFINE') then
begin
if FDefineState.DoWrite then