Skip to content

Commit 1f1ed85

Browse files
pultpult
committed
@TetzkatLipHoka: $IF Support
@TetzkatLipHoka: $IF Defined remobjects#265
1 parent 2300851 commit 1f1ed85

2 files changed

Lines changed: 124 additions & 17 deletions

File tree

‎Source/uPSPreProcessor.pas‎

Lines changed: 121 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
{ uPSPreProcessor.pas } // version: 2022.1123.1400
1+
{ uPSPreProcessor.pas } // version: 2022.1123.1500
22
{----------------------------------------------------------------------------}
33
{ RemObjects Pascal Script }
44
{----------------------------------------------------------------------------}
@@ -175,10 +175,12 @@ TPSDefineStates = class
175175
implementation
176176

177177
{+}
178-
{$IFDEF DELPHI12UP}
179178
uses
180-
AnsiStrings;
181-
{$ENDIF}
179+
StrUtils
180+
{$IFDEF DELPHI12UP}
181+
,AnsiStrings
182+
{$ENDIF}
183+
;
182184
{+.}
183185

184186
{$if (defined(DELPHI3UP) or defined(FPC))}
@@ -192,6 +194,8 @@ implementation
192194
RPS_IncludeNotFoundFrom = ' used from ''%s''';
193195
{+.}
194196
RPS_DefineTooManyParameters = 'Too many parameters in ''%s'' at %d:%d';
197+
RPS_DefineTooLessParameters = 'Too less parameters in ''%s'' at %d:%d';
198+
RPS_DefineInvalidParameters = 'Invalid parameters in ''%s'' at %d:%d';
195199
RPS_NoIfdefForEndif = 'No IFDEF for ENDIF in ''%s'' at %d:%d';
196200
RPS_NoIfdefForElse = 'No IFDEF for ELSE in ''%s'' at %d:%d';
197201
RPS_ElseTwice = 'Can''t use ELSE twice in ''%s'' at %d:%d';
@@ -578,15 +582,19 @@ procedure TPSPreProcessor.doAddStdPredefines;
578582

579583
procedure TPSPreProcessor.IntPreProcess(Level: Integer; const OrgFileName, AFileName: TbtString;
580584
Dest: TStream);
585+
const // TetzkatLipHoka: implement "$IF Defined" https://github.com/remobjects/pascalscript/pull/265
586+
sDEFINED = 'DEFINED(';
587+
sNOT = 'NOT';
588+
sAND = 'AND';
589+
sOR = 'OR';
590+
sANDNOT = 'ANDNOT';
591+
sORNOT = 'ORNOT';
592+
sCompilerVersion = 'COMPILERVERSION';
581593
var
582594
Parser: TPSPascalPreProcessorParser;
583-
FileName, dta: TbtString;
584-
item: TPSLineInfo;
585-
s, name: TbtString;
586-
current, i: Longint;
587-
ds: TPSDefineState;
588-
AppContinue: Boolean;
589-
ADoWrite: Boolean;
595+
dta: TbtString; item: TPSLineInfo; FileName, s, ts, name: TbtString;
596+
current, i, j: Longint; ds: TPSDefineState;
597+
OK, AppContinue, ADoWrite: Boolean;
590598
begin
591599
FileName := AFileName;
592600
if Level > MaxLevel then
@@ -677,7 +685,7 @@ procedure TPSPreProcessor.IntPreProcess(Level: Integer; const OrgFileName, AFile
677685
ADoWrite := (FCurrentDefines.IndexOf(UpperCase(string(s))) < 0) and FDefineState.DoWrite;
678686
FDefineState.Add.DoWrite := ADoWrite;
679687
{+.}
680-
end else if (Name = 'ENDIF') then begin
688+
end else if (Name = 'ENDIF') or (Name = 'IFEND') then begin
681689
//- jgv remove - borland use it (sysutils.pas)
682690
//- if s <> '' then raise EPSPreProcessor.CreateFmt(RPS_DefineTooManyParameters, [string(FileName), Parser.Row, Parser.Col]);
683691
if FDefineState.Count = 0 then
@@ -694,8 +702,107 @@ procedure TPSPreProcessor.IntPreProcess(Level: Integer; const OrgFileName, AFile
694702
ds.FInElse := True;
695703
//JeromeWelsh - nesting fix
696704
ds.DoWrite := not ds.DoWrite and FDefineState.DoPrevWrite;
697-
end
698-
else begin
705+
end else if (Name = 'IF') then begin
706+
OK := PosT(' ', S) <= 0;
707+
if OK then
708+
raise EPSPreProcessor.CreateFmt(RPS_DefineTooLessParameters, [FileName, Parser.Row, Parser.Col]);
709+
S := Trim(S);
710+
S := UpperCase(S);
711+
S := StringReplaceT(S, #32#32, #32, [rfReplaceAll]);
712+
S := StringReplaceT(S, ' (', '(', [rfReplaceAll]);
713+
S := StringReplaceT(S, '( ', '(', [rfReplaceAll]);
714+
S := StringReplaceT(S, ' )', ')', [rfReplaceAll]);
715+
S := StringReplaceT(S, ') ', ')', [rfReplaceAll]);
716+
OK := (Copy(S, 1, Length(sDEFINED))=sDEFINED)
717+
or (Copy(S, 1, Length(sNOT) + Length(sDEFINED)) = sNOT + sDEFINED)
718+
or (Copy(S, 1, Length(sNOT) + Length(sDEFINED) + 1 ) = sNOT + ' ' + sDEFINED)
719+
;
720+
if OK then begin // MS
721+
S := StringReplaceT(S, ' NOT', 'NOT', [rfReplaceAll]);
722+
S := StringReplaceT(S, 'NOT ', 'NOT', [rfReplaceAll]);
723+
S := StringReplaceT(S, ' AND', 'AND', [rfReplaceAll]);
724+
S := StringReplaceT(S, 'AND ', 'AND', [rfReplaceAll]);
725+
S := StringReplaceT(S, ' OR', 'OR', [rfReplaceAll]);
726+
S := StringReplaceT(S, 'OR ', 'OR', [rfReplaceAll]);
727+
ADoWrite := FDefineState.DoWrite;
728+
ts := S;
729+
if (Copy(ts, 1, Length(sNOT)) = sNOT) then begin
730+
j := 2;
731+
ts := Copy(ts, Length(sNOT)+1, Length(ts)-Length(sNOT));
732+
end else
733+
j := 0; // AND
734+
while (ts <> '') do begin
735+
i := PosExT(')', ts, Length(sDEFINED)+1);
736+
if (i = 0) then begin
737+
raise EPSPreProcessor.CreateFmt(RPS_DefineInvalidParameters, [FileName, Parser.Row, Parser.Col]);
738+
Break;
739+
end;
740+
case j of
741+
0: // AND
742+
ADoWrite := ADoWrite and
743+
(FCurrentDefines.IndexOf(string(Copy(ts, Length(sDefined)+1, i-Length(sDefined)-1))) >= 0);
744+
1: // OR
745+
ADoWrite := ADoWrite or
746+
(FCurrentDefines.IndexOf(string(Copy(ts, Length(sDefined)+1, i-Length(sDefined)-1))) >= 0);
747+
2: // (AND) NOT
748+
ADoWrite := ADoWrite and
749+
(FCurrentDefines.IndexOf(string(Copy(ts, Length(sDefined)+1, i-Length(sDefined)-1))) < 0);
750+
3: // OR NOT
751+
ADoWrite := ADoWrite or
752+
(FCurrentDefines.IndexOf(string(Copy(ts, Length(sDefined)+1, i-Length(sDefined)-1))) < 0);
753+
else
754+
ADoWrite := ADoWrite or
755+
(FCurrentDefines.IndexOf(string(Copy(ts, Length(sDefined)+1, i-Length(sDefined)-1))) >= 0);
756+
end; //case j
757+
ts := Copy(ts, i+1, Length( ts )-i);
758+
if (Copy(ts, 1, Length(sANDNOT)) = sANDNOT ) then begin
759+
j := 2;
760+
ts := Copy(ts, Length(sANDNOT)+1, Length(ts)-Length(sANDNOT));
761+
end else if (Copy(ts, 1, Length(sORNOT)) = sORNOT) then begin
762+
j := 3;
763+
ts := Copy(ts, Length(sORNOT)+1, Length(ts)-Length(sORNOT));
764+
end else if (Copy(ts, 1, Length(sAND)) = sAND) then begin
765+
j := 0;
766+
ts := Copy(ts, Length(sAND)+1, Length(ts)-Length(sAND));
767+
end else if (Copy(ts, 1, Length(sOR)) = sOR) then begin
768+
j := 1;
769+
ts := Copy(ts, Length(sOR)+1, Length(ts)-Length(sOR));
770+
end;
771+
end; // "while (ts <> '')"
772+
FDefineState.Add.DoWrite := ADoWrite;
773+
end else if (Copy(S, 1, Length(sCompilerVersion)) = sCompilerVersion) then begin
774+
S := StringReplaceT(S, #32, '', [rfReplaceAll]);
775+
if (Copy(S, 16, 2) = '>=') then
776+
FDefineState.Add.DoWrite := ( StrToIntDef(Copy(S, 18, Length(S)-17), -1 ) >= CompilerVersion )
777+
else if (Copy(S, 16, 2) = '<=') then
778+
FDefineState.Add.DoWrite := ( StrToIntDef(Copy(S, 18, Length(S)-17), High( Integer ) ) <= CompilerVersion )
779+
else if (Copy(S, 16, 1) = '<') then
780+
FDefineState.Add.DoWrite := ( StrToIntDef(Copy(S, 17, Length(S)-16), High( Integer ) ) < CompilerVersion )
781+
else if (Copy(S, 16, 1) = '>') then
782+
FDefineState.Add.DoWrite := ( StrToIntDef(Copy(S, 17, Length(S)-16), -1 ) > CompilerVersion )
783+
else if (Copy(S, 16, 1) = '=') then
784+
FDefineState.Add.DoWrite := ( StrToIntDef(Copy(S, 17, Length(S)-16), -1 ) = CompilerVersion )
785+
else
786+
raise EPSPreProcessor.CreateFmt(RPS_DefineInvalidParameters, [FileName, Parser.Row, Parser.Col]);
787+
end else begin
788+
//-- jgv: 20050710 custom application error process
789+
if @OnProcessUnknowDirective <> nil then begin
790+
OnProcessUnknowDirective(Self, Parser, FDefineState.DoWrite, name, {+}TbtString(s){+.}, AppContinue);
791+
end;
792+
if AppContinue then
793+
//-- jgv.
794+
raise EPSPreProcessor.CreateFmt(RPS_UnknownCompilerDirective, [string(FileName), Parser.Row, Parser.Col]);
795+
end;
796+
// Compatibility Dummys
797+
end else if (Name = 'UNSAFE_TYPE') or (Name = 'UNSAFE_CODE') or (Name = 'UNSAFE_CAST') OR (Name = 'SYMBOL_PLATFORM')
798+
or (Name = 'GARBAGE') or (Name = 'WARN') or (Name = 'RANGECHECKS')
799+
or (Name = 'WEAKPACKAGEUNIT') or (Name = 'EXTERNALSYM') or (Name = 'NODEFINE')
800+
then begin
801+
SetLength(s, Length(Parser.Token));
802+
for i := Length(s) downto 1 do begin
803+
s[i] := #32; // space
804+
end;
805+
end else begin
699806
//-- jgv: 20050710 custom application error process
700807
if @OnProcessUnknowDirective <> nil then begin
701808
OnProcessUnknowDirective(Self, Parser, FDefineState.DoWrite, name, {+}TbtString(s){+.}, AppContinue);

‎Source/uPSUtils.pas‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
{ uPSUtils.pas } // version: 2022.1123.1400
1+
{ uPSUtils.pas } // version: 2022.1123.1500
22
{----------------------------------------------------------------------------}
33
{ RemObjects Pascal Script }
44
{----------------------------------------------------------------------------}
@@ -18,15 +18,15 @@ interface
1818

1919
{+}
2020
const
21-
uPSVersion = 202211231400; // format: yyyymmddhhnn
21+
uPSVersion = 202211231500; // format: yyyymmddhhnn
2222
// yyyymmddhhnn
2323
{$EXTERNALSYM uPSVersion}
2424
(*
2525
// Sample for checking library version:
2626
// <sample>
2727
uses ... uPSUtils ...
2828
{$warn comparison_true off}
29-
{$if (not declared(uPSVersion)) or (uPSVersion < 202211231400)}
29+
{$if (not declared(uPSVersion)) or (uPSVersion < 202211231500)}
3030
//{$warn message_directive on}{$MESSAGE WARN 'Need update RemObjects Pascal Script Library'}
3131
{$MESSAGE FATAL 'Need update RemObjects Pascal Script Library'}
3232
{$ifend}{$warnings on}

0 commit comments

Comments
 (0)