mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-29 19:52:26 +02:00
codetools: config parser stack
git-svn-id: trunk@26900 -
This commit is contained in:
parent
f2451b97a9
commit
3416e11123
@ -1632,19 +1632,19 @@ begin
|
||||
// read til next atom
|
||||
while (Position<=Len) do begin
|
||||
case Src[Position-1] of
|
||||
#0..#32: // spaces and special characters
|
||||
#0..#32: // spaces and special characters
|
||||
begin
|
||||
inc(Position);
|
||||
end;
|
||||
#$EF:
|
||||
if (Src[Position]=#$BB)
|
||||
and (Src[Position+1]=#$BF) then begin
|
||||
// skip UTF BOM
|
||||
inc(Position,3);
|
||||
end else begin
|
||||
break;
|
||||
end;
|
||||
'{': // comment start or compiler directive
|
||||
#$EF:
|
||||
if (Src[Position]=#$BB)
|
||||
and (Src[Position+1]=#$BF) then begin
|
||||
// skip UTF BOM
|
||||
inc(Position,3);
|
||||
end else begin
|
||||
break;
|
||||
end;
|
||||
'{': // comment start or compiler directive
|
||||
begin
|
||||
if (Position<Len) and (Src[Position]='$') then
|
||||
// compiler directive
|
||||
@ -1672,7 +1672,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
'/': // comment or real division
|
||||
'/': // comment or real division
|
||||
if (Position<Len) and (Src[Position]='/') then begin
|
||||
// comment start -> read til line end
|
||||
inc(Position);
|
||||
@ -1680,7 +1680,7 @@ begin
|
||||
inc(Position);
|
||||
end else
|
||||
break;
|
||||
'(': // comment, bracket or compiler directive
|
||||
'(': // comment, bracket or compiler directive
|
||||
if (Position<Len) and (Src[Position]='*') then begin
|
||||
if (Position+2<=Len) and (Src[Position+1]='$') then
|
||||
// compiler directive
|
||||
|
@ -66,12 +66,48 @@ type
|
||||
CreateIfNotExists: Boolean = false): PCTCfgScriptVariable;
|
||||
end;
|
||||
|
||||
|
||||
TCTCfgScriptStackItemType = (
|
||||
ctcssNone,
|
||||
ctcssStatement,
|
||||
ctcssIf,
|
||||
ctcssIfThen,
|
||||
ctcssIfElse,
|
||||
ctcssRoundBracketOpen,
|
||||
ctcssBegin
|
||||
);
|
||||
TCTCfgScriptStackItem = record
|
||||
Typ: TCTCfgScriptStackItemType;
|
||||
StartPos: integer;
|
||||
Operand: TCTCfgScriptVariable;
|
||||
end;
|
||||
PCTCfgScriptStackItem = ^TCTCfgScriptStackItem;
|
||||
|
||||
{ TCTCfgScriptStack }
|
||||
|
||||
TCTCfgScriptStack = class
|
||||
public
|
||||
Items: PCTCfgScriptStackItem;
|
||||
Top: integer; // current item, -1 = empty
|
||||
Capacity: integer;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
procedure Push(Typ: TCTCfgScriptStackItemType; StartPos: integer);
|
||||
procedure Pop;
|
||||
end;
|
||||
|
||||
{ TCTConfigScriptEngine }
|
||||
|
||||
TCTConfigScriptEngine = class
|
||||
private
|
||||
FVariables: TCTCfgScriptVariables;
|
||||
FStack: TCTCfgScriptStack;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
property Variables: TCTCfgScriptVariables read FVariables;
|
||||
procedure Execute(const Src: string; StopAfterErrors: integer = 1);
|
||||
end;
|
||||
|
||||
function CompareCTCSVariables(Var1, Var2: Pointer): integer;
|
||||
@ -361,13 +397,91 @@ end;
|
||||
|
||||
constructor TCTConfigScriptEngine.Create;
|
||||
begin
|
||||
|
||||
FVariables:=TCTCfgScriptVariables.Create;
|
||||
FStack:=TCTCfgScriptStack.Create;
|
||||
end;
|
||||
|
||||
destructor TCTConfigScriptEngine.Destroy;
|
||||
begin
|
||||
FreeAndNil(FVariables);
|
||||
FreeAndNil(FStack);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCTConfigScriptEngine.Execute(const Src: string;
|
||||
StopAfterErrors: integer);
|
||||
var
|
||||
p: PChar;
|
||||
begin
|
||||
FStack.Clear;
|
||||
|
||||
if Src='' then exit;
|
||||
|
||||
p:=PChar(Src);
|
||||
while p^<>#0 do inc(p);
|
||||
end;
|
||||
|
||||
{ TCTCfgScriptStack }
|
||||
|
||||
constructor TCTCfgScriptStack.Create;
|
||||
begin
|
||||
Top:=-1;
|
||||
end;
|
||||
|
||||
destructor TCTCfgScriptStack.Destroy;
|
||||
begin
|
||||
Clear;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCTCfgScriptStack.Clear;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to Top do
|
||||
ClearCTCSVariable(@Items[i].Operand);
|
||||
Top:=-1;
|
||||
Capacity:=0;
|
||||
ReAllocMem(Items,0);
|
||||
end;
|
||||
|
||||
procedure TCTCfgScriptStack.Push(Typ: TCTCfgScriptStackItemType;
|
||||
StartPos: integer);
|
||||
var
|
||||
OldCapacity: LongInt;
|
||||
Item: PCTCfgScriptStackItem;
|
||||
begin
|
||||
inc(Top);
|
||||
if Top>=Capacity then begin
|
||||
OldCapacity:=Capacity;
|
||||
if Capacity<10 then
|
||||
Capacity:=10
|
||||
else
|
||||
Capacity:=Capacity*2;
|
||||
ReAllocMem(Items,Capacity*SizeOf(TCTCfgScriptStackItem));
|
||||
FillByte(Items[OldCapacity],(Capacity-OldCapacity)*SizeOf(TCTCfgScriptStackItem),0);
|
||||
end;
|
||||
Item:=@Items[Top];
|
||||
Item^.Typ:=Typ;
|
||||
Item^.StartPos:=StartPos;
|
||||
end;
|
||||
|
||||
procedure TCTCfgScriptStack.Pop;
|
||||
|
||||
procedure RaiseTooManyPop;
|
||||
begin
|
||||
raise Exception.Create('TCTCfgScriptStack.Pop too many pop');
|
||||
end;
|
||||
|
||||
var
|
||||
Item: PCTCfgScriptStackItem;
|
||||
begin
|
||||
if Top<0 then
|
||||
RaiseTooManyPop;
|
||||
Item:=@Items[Top];
|
||||
ClearCTCSVariable(@Item^.Operand);
|
||||
dec(Top);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user