paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-27 04:33:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: fixed stack pop

Browse Source 
git-svn-id: trunk@27511 -
This commit is contained in:
mattias 2010-09-28 17:12:12 +00:00
parent 0f2583abfe
commit b5a26a3c72
3 changed files with 13 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
components/codetools/codetoolscfgscript.pas
View File

@ -1273,6 +1273,9 @@ procedure TCTConfigScriptEngine.AddError(const aMsg: string; ErrorPos: PChar);
var var
Err: TCTCfgScriptError; Err: TCTCfgScriptError;
begin begin
{$IFDEF VerboseCTCfgScript}
WriteDebugReportStack('ERROR: '+aMsg);
{$ENDIF}
Err:=TCTCfgScriptError.Create(aMsg,ErrorPos); Err:=TCTCfgScriptError.Create(aMsg,ErrorPos);
FErrors.Add(Err); FErrors.Add(Err);
if ErrorCount>=MaxErrorCount then if ErrorCount>=MaxErrorCount then
@ -1369,12 +1372,12 @@ begin
FStack.Push(ctcssBegin,AtomStart); FStack.Push(ctcssBegin,AtomStart);
repeat repeat
ReadRawNextPascalAtom(Src,AtomStart); ReadRawNextPascalAtom(Src,AtomStart);
//debugln(['TCTConfigScriptEngine.RunBegin ',GetAtom]);
if (AtomStart^=#0) then begin if (AtomStart^=#0) then begin
ErrorMissingEnd; ErrorMissingEnd;
break; break;
end else if CompareIdentifiers('END',AtomStart)=0 then begin end else if CompareIdentifiers('END',AtomStart)=0 then begin
FStack.Pop; FStack.Pop;
ReadRawNextPascalAtom(Src,AtomStart);
break; break;
end else if AtomStart=';' then begin end else if AtomStart=';' then begin
// skip // skip
@ -1444,6 +1447,7 @@ begin
exit; exit;
end; end;
Variables.Undefine(VarStart); Variables.Undefine(VarStart);
ReadRawNextPascalAtom(Src,AtomStart);
end; end;
procedure TCTConfigScriptEngine.RunAssignment(Skip: boolean); procedure TCTConfigScriptEngine.RunAssignment(Skip: boolean);
@ -1751,7 +1755,9 @@ function TCTConfigScriptEngine.RunExpression: boolean;
ctcssExpression,ctcssOperator,ctcssRoundBracketOpen: ctcssExpression,ctcssOperator,ctcssRoundBracketOpen:
Result:=true; Result:=true;
else else
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.RunExpression.OperandAllowed no']); debugln(['TCTConfigScriptEngine.RunExpression.OperandAllowed no']);
{$ENDIF}
AddError('operator expected but '+GetAtom+' found'); AddError('operator expected but '+GetAtom+' found');
Result:=false; Result:=false;
end; end;
@ -1763,7 +1769,9 @@ function TCTConfigScriptEngine.RunExpression: boolean;
ctcssOperand: ctcssOperand:
Result:=true; Result:=true;
else else
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.RunExpression.BinaryOperatorAllowed no']); debugln(['TCTConfigScriptEngine.RunExpression.BinaryOperatorAllowed no']);
{$ENDIF}
AddError('operand expected but '+GetAtom+' found'); AddError('operand expected but '+GetAtom+' found');
Result:=false; Result:=false;
end; end;
@ -2188,7 +2196,7 @@ begin
begin begin
if (FStack.Top>=2) then begin if (FStack.Top>=2) then begin
LeftOperandItem:=@FStack.Items[FStack.Top-2]; LeftOperandItem:=@FStack.Items[FStack.Top-2];
// add right operand to left oprerand on stack // add right operand to left operand on stack
AddCTCSVariables(@OperandItem^.Operand,@LeftOperandItem^.Operand); AddCTCSVariables(@OperandItem^.Operand,@LeftOperandItem^.Operand);
// remove right operand and + // remove right operand and +
FStack.Pop(2); FStack.Pop(2);
@ -2465,7 +2473,7 @@ begin
ReAllocMem(Item^.Operand.Name,0); ReAllocMem(Item^.Operand.Name,0);
dec(Top); dec(Top);
if Top>=0 then if Top>=0 then
TopTyp:=Items[0].Typ TopTyp:=Items[Top].Typ
else else
TopTyp:=ctcssNone; TopTyp:=ctcssNone;
dec(Count); dec(Count);

6
components/codetools/examples/runcfgscript.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0"?> <?xml version="1.0"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="8"/> <Version Value="9"/>
<General> <General>
<Flags> <Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/> <MainUnitHasUsesSectionForAllUnits Value="False"/>
@ -11,12 +11,8 @@
</Flags> </Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<TargetFileExt Value=""/>
<Title Value="runcfgscript"/> <Title Value="runcfgscript"/>
</General> </General>
<VersionInfo>
<StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion="0.0.0.0"/>
</VersionInfo>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>

1
components/codetools/examples/runcfgscript.lpr
View File

@ -60,6 +60,7 @@ begin
Engine:=TCTConfigScriptEngine.Create; Engine:=TCTConfigScriptEngine.Create;
try try
//Engine.MaxErrorCount:=0;
if not Engine.Execute(Src) then begin if not Engine.Execute(Src) then begin
writeln('Script failed to run:'); writeln('Script failed to run:');
for i:=0 to Engine.ErrorCount-1 do for i:=0 to Engine.ErrorCount-1 do