paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-27 22:57:14 +01:00
Code Issues Packages Projects Releases Wiki Activity

codetools: expreval: support for defined(#var)

Browse Source 
git-svn-id: trunk@26296 -
This commit is contained in:
mattias 2010-06-27 16:49:58 +00:00
parent 3962bb560c
commit dee92243f1
2 changed files with 74 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
components/codetools/definetemplates.pas
View File

@ -289,6 +289,7 @@ type
procedure InheritMarks(WithSiblings, WithChilds, Down, Up: boolean); procedure InheritMarks(WithSiblings, WithChilds, Down, Up: boolean);
procedure InsertBehind(APrior: TDefineTemplate); procedure InsertBehind(APrior: TDefineTemplate);
procedure InsertInFront(ANext: TDefineTemplate); procedure InsertInFront(ANext: TDefineTemplate);
procedure MoveToLast(Child: TDefineTemplate);
procedure LoadValuesFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; procedure LoadValuesFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
WithMergeInfo: boolean); WithMergeInfo: boolean);
procedure MarkFlags(const MustFlags, NotFlags: TDefineTemplateFlags; procedure MarkFlags(const MustFlags, NotFlags: TDefineTemplateFlags;
@ -2249,6 +2250,17 @@ begin
ANext.FPrior:=LastSibling; ANext.FPrior:=LastSibling;
end; end;
procedure TDefineTemplate.MoveToLast(Child: TDefineTemplate);
var
Node: TDefineTemplate;
begin
if Child.Next=nil then exit;
Node:=Child.Next;
while Node.Next<>nil do Node:=Node.Next;
Child.Unbind;
Child.InsertBehind(Node);
end;
procedure TDefineTemplate.Assign(ADefineTemplate: TDefineTemplate; procedure TDefineTemplate.Assign(ADefineTemplate: TDefineTemplate;
WithSubNodes, WithNextSiblings, ClearOldSiblings: boolean); WithSubNodes, WithNextSiblings, ClearOldSiblings: boolean);
var ChildTemplate, CopyTemplate, NextTemplate: TDefineTemplate; var ChildTemplate, CopyTemplate, NextTemplate: TDefineTemplate;
@ -3656,13 +3668,14 @@ var
begin begin
// test expression in value // test expression in value
ReadValue(DirDef,DefTempl.Value,CurPath,TempValue); ReadValue(DirDef,DefTempl.Value,CurPath,TempValue);
EvalResult:=DirDef.Values.Eval(TempValue); EvalResult:=DirDef.Values.Eval(TempValue,true);
if Assigned(OnCalculate) then if Assigned(OnCalculate) then
OnCalculate(Self,DefTempl,true,TempValue,true,EvalResult,EvalResult='1'); OnCalculate(Self,DefTempl,true,TempValue,true,EvalResult,EvalResult='1');
//debugln('da_If,da_ElseIf: DefTempl.Value="',DbgStr(DefTempl.Value),'" CurPath="',CurPath,'" TempValue="',TempValue,'" EvalResult=',EvalResult); //debugln('da_If,da_ElseIf: DefTempl.Value="',DbgStr(DefTempl.Value),'" CurPath="',CurPath,'" TempValue="',TempValue,'" EvalResult=',EvalResult);
if DirDef.Values.ErrorPosition>=0 then begin if DirDef.Values.ErrorPosition>=0 then begin
FErrorDescription:=Format(ctsSyntaxErrorInExpr,[TempValue]); FErrorDescription:=Format(ctsSyntaxErrorInExpr,[TempValue]);
FErrorTemplate:=DefTempl; FErrorTemplate:=DefTempl;
//debugln(['CalculateTemplate "',FErrorDescription,'"']);
end else if EvalResult='1' then end else if EvalResult='1' then
CalculateIfChilds; CalculateIfChilds;
end; end;

105
components/codetools/expreval.pas
View File

@ -106,7 +106,7 @@ type
function CompareValues(const v1, v2: string): integer; function CompareValues(const v1, v2: string): integer;
function GetVariables(const Name: string): string; function GetVariables(const Name: string): string;
procedure SetVariables(const Name: string; const Value: string); procedure SetVariables(const Name: string; const Value: string);
function IndexOfName(const VarName: string; InsertPos: boolean): integer; function IndexOfName(VarName: PChar; VarLen: integer; InsertPos: boolean): integer;
function IndexOfIdentifier(Identifier: PChar; InsertPos: boolean): integer; function IndexOfIdentifier(Identifier: PChar; InsertPos: boolean): integer;
procedure Expand; procedure Expand;
public public
@ -119,10 +119,10 @@ type
function Equals(AnExpressionEvaluator: TExpressionEvaluator): boolean; reintroduce; function Equals(AnExpressionEvaluator: TExpressionEvaluator): boolean; reintroduce;
procedure Assign(SourceExpressionEvaluator: TExpressionEvaluator); procedure Assign(SourceExpressionEvaluator: TExpressionEvaluator);
procedure AssignTo(SL: TStringList); procedure AssignTo(SL: TStringList);
function Eval(const Expression: string):string; function Eval(const Expression: string; AllowExternalMacro: boolean = false):string;
function EvalPChar(Expression: PChar; ExprLen: PtrInt; function EvalPChar(Expression: PChar; ExprLen: PtrInt;
out Operand: TEvalOperand): boolean;// true if expression valid out Operand: TEvalOperand; AllowExternalMacro: boolean = false): boolean;// true if expression valid
function EvalBoolean(Expression: PChar; ExprLen: PtrInt): boolean; function EvalBoolean(Expression: PChar; ExprLen: PtrInt; AllowExternalMacro: boolean = false): boolean;
function EvalOld(const Expression: string):string; function EvalOld(const Expression: string):string;
property ErrorPosition: integer read FErrorPos write FErrorPos; property ErrorPosition: integer read FErrorPos write FErrorPos;
property ErrorMsg: string read FErrorMsg write FErrorMsg; property ErrorMsg: string read FErrorMsg write FErrorMsg;
@ -902,8 +902,8 @@ begin
ReAllocMem(FNames,NewSize); ReAllocMem(FNames,NewSize);
end; end;
function TExpressionEvaluator.IndexOfName( function TExpressionEvaluator.IndexOfName(VarName: PChar; VarLen: integer;
const VarName: string; InsertPos: boolean): integer; InsertPos: boolean): integer;
var l,r,m, cmp: integer; var l,r,m, cmp: integer;
begin begin
if FCount=0 then begin if FCount=0 then begin
@ -919,7 +919,7 @@ begin
cmp:=0; cmp:=0;
while l<=r do begin while l<=r do begin
m:=(l+r) shr 1; m:=(l+r) shr 1;
cmp:=CompareNames(VarName,FNames[m]); cmp:=CompareNames(VarName,VarLen,PChar(FNames[m]),length(FNames[m]));
if cmp>0 then if cmp>0 then
l:=m+1 l:=m+1
else if cmp<0 then else if cmp<0 then
@ -979,7 +979,7 @@ end;
function TExpressionEvaluator.GetVariables(const Name: string): string; function TExpressionEvaluator.GetVariables(const Name: string): string;
var i: integer; var i: integer;
begin begin
i:=IndexOfName(Name,false); i:=IndexOfName(PChar(Name),length(Name),false);
if (i>=0) then if (i>=0) then
Result:=FValues[i] Result:=FValues[i]
else else
@ -988,7 +988,7 @@ end;
function TExpressionEvaluator.IsDefined(const Name: string): boolean; function TExpressionEvaluator.IsDefined(const Name: string): boolean;
begin begin
Result:=IndexOfName(Name,false)>=0; Result:=IndexOfName(PChar(Name),length(Name),false)>=0;
end; end;
function TExpressionEvaluator.IsIdentifierDefined(Identifier: PChar): boolean; function TExpressionEvaluator.IsIdentifierDefined(Identifier: PChar): boolean;
@ -1109,7 +1109,7 @@ procedure TExpressionEvaluator.SetVariables(const Name: string;
var i: integer; var i: integer;
Size: Integer; Size: Integer;
begin begin
i:=IndexOfName(Name,true); i:=IndexOfName(PChar(Name),length(Name),true);
if (i>=0) and (i<FCount) and (CompareNames(FNames[i],Name)=0) then begin if (i>=0) and (i<FCount) and (CompareNames(FNames[i],Name)=0) then begin
// variable already exists -> replace value // variable already exists -> replace value
if FValues[i]<>Value then begin if FValues[i]<>Value then begin
@ -1138,7 +1138,7 @@ procedure TExpressionEvaluator.Undefine(const Name: string);
var i: integer; var i: integer;
Size: Integer; Size: Integer;
begin begin
i:=IndexOfName(Name,false); i:=IndexOfName(PChar(Name),length(Name),false);
if (i>=0) then begin if (i>=0) then begin
FNames[i]:=''; FNames[i]:='';
FValues[i]:=''; FValues[i]:='';
@ -1179,14 +1179,15 @@ begin
SL.Add(FNames[i]+'='+FValues[i]); SL.Add(FNames[i]+'='+FValues[i]);
end; end;
function TExpressionEvaluator.Eval(const Expression: string): string; function TExpressionEvaluator.Eval(const Expression: string;
AllowExternalMacro: boolean): string;
{ 0 = false { 0 = false
else true } else true }
var var
Operand: TEvalOperand; Operand: TEvalOperand;
begin begin
if Expression='' then exit('0'); if Expression='' then exit('0');
if not EvalPChar(PChar(Expression),length(Expression),Operand) then if not EvalPChar(PChar(Expression),length(Expression),Operand,AllowExternalMacro) then
Result:='' Result:=''
else begin else begin
SetLength(Result,Operand.Len); SetLength(Result,Operand.Len);
@ -1196,8 +1197,8 @@ begin
FreeEvalOperand(Operand); FreeEvalOperand(Operand);
end; end;
function TExpressionEvaluator.EvalPChar(Expression: PChar; ExprLen: PtrInt; function TExpressionEvaluator.EvalPChar(Expression: PChar; ExprLen: PtrInt; out
out Operand: TEvalOperand): boolean; Operand: TEvalOperand; AllowExternalMacro: boolean): boolean;
{ 0 = false { 0 = false
else true else true
@ -1219,7 +1220,7 @@ type
var var
ExprStack: TExprStack; ExprStack: TExprStack;
StackPtr: integer; // -1 = empty StackPtr: integer; // -1 = empty
ExprEnd: Pointer; ExprEnd: PChar;
p, AtomStart: PChar; p, AtomStart: PChar;
procedure FreeStack; procedure FreeStack;
@ -1371,8 +1372,13 @@ var
f: string; f: string;
begin begin
s:=ExpectedStr; s:=ExpectedStr;
f:=NewErrorPos^; if ExprEnd>NewErrorPos then begin
Error(NewErrorPos,'expected '+s+', but found '+f); SetLength(f,ExprEnd-NewErrorPos);
System.Move(NewErrorPos^,f[1],ExprEnd-NewErrorPos);
Error(NewErrorPos,'expected '+s+', but found '+f);
end else begin
Error(NewErrorPos,'expected '+s);
end;
end; end;
function ReadTilEndBracket: boolean; function ReadTilEndBracket: boolean;
@ -1403,7 +1409,7 @@ var
// p is behind defined or undefined keyword // p is behind defined or undefined keyword
// Operand: '1' or '-1' // Operand: '1' or '-1'
var var
NeedBracketClose: Boolean; NameStart: PChar;
begin begin
Result:=false; Result:=false;
ReadNextAtom; ReadNextAtom;
@ -1411,37 +1417,45 @@ var
IdentifierMissing(AtomStart); IdentifierMissing(AtomStart);
exit; exit;
end; end;
NeedBracketClose:=false; if IsIdentifierChar[AtomStart^] then begin
if AtomStart^='(' then begin if IsIdentifierDefined(AtomStart) then begin
// defined( SetOperandValueChar(Operand,'1');
NeedBracketClose:=true; end else begin
SetOperandValueConst(Operand,'0');
end;
end else if AtomStart^='(' then begin
ReadNextAtom; ReadNextAtom;
// skip space if p=AtomStart then begin
if AtomStart>=ExprEnd then begin StrExpectedAtPos(AtomStart,'macro name');
IdentifierMissing(AtomStart);
exit; exit;
end; end;
end; if AtomStart^=')' then begin
if not IsIdentifierChar[AtomStart^] then begin SetOperandValueConst(Operand,'0');
StrExpectedAtPos(AtomStart,'macro name'); exit(true);
exit; end;
end; NameStart:=AtomStart;
if IsIdentifierDefined(AtomStart) then begin if (AtomStart^=ExternalMacroStart) and AllowExternalMacro then begin
SetOperandValueChar(Operand,'1'); inc(AtomStart);
end else begin p:=AtomStart;
SetOperandValueConst(Operand,'0'); end;
end; if not IsIdentStartChar[AtomStart^] then begin
if NeedBracketClose then begin StrExpectedAtPos(AtomStart,'macro name');
// read bracket close
ReadNextAtom;
if AtomStart>=ExprEnd then begin
CharMissing(ExprEnd,')');
exit; exit;
end; end;
while IsIdentifierChar[p^] do inc(p);
if IndexOfName(NameStart,p-NameStart,false)>=0 then begin
SetOperandValueConst(Operand,'1');
end else begin
SetOperandValueConst(Operand,'0');
end;
ReadNextAtom;
if AtomStart^<>')' then begin if AtomStart^<>')' then begin
StrExpectedAtPos(AtomStart,')'); StrExpectedAtPos(AtomStart,')');
exit; exit;
end; end;
end else begin
StrExpectedAtPos(AtomStart,'macro name');
exit;
end; end;
Result:=true; Result:=true;
end; end;
@ -1913,12 +1927,13 @@ begin
end; end;
end; end;
function TExpressionEvaluator.EvalBoolean(Expression: PChar; ExprLen: PtrInt function TExpressionEvaluator.EvalBoolean(Expression: PChar; ExprLen: PtrInt;
): boolean; AllowExternalMacro: boolean): boolean;
var var
Operand: TEvalOperand; Operand: TEvalOperand;
begin begin
Result:=EvalPChar(Expression,ExprLen,Operand) and EvalOperandIsTrue(Operand); Result:=EvalPChar(Expression,ExprLen,Operand,AllowExternalMacro)
and EvalOperandIsTrue(Operand);
FreeEvalOperand(Operand); FreeEvalOperand(Operand);
end; end;
@ -1988,7 +2003,7 @@ begin
if WithNamesAndValues then begin if WithNamesAndValues then begin
for i:=0 to FCount-1 do begin for i:=0 to FCount-1 do begin
if Original<>nil then begin if Original<>nil then begin
j:=Original.IndexOfName(FNames[i],false); j:=Original.IndexOfName(PChar(FNames[i]),length(FNames[i]),false);
if j>=0 then begin if j>=0 then begin
if Pointer(FNames[i])=Pointer(Original.FNames[j]) then continue; if Pointer(FNames[i])=Pointer(Original.FNames[j]) then continue;
end; end;