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

codetools: fixed parsing string constant without end

Browse Source 
git-svn-id: trunk@26906 -
This commit is contained in:
mattias 2010-07-29 15:34:26 +00:00
parent 448387e85a
commit 01e74e733f
3 changed files with 95 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
components/codetools/basiccodetools.pas
View File

@ -1703,7 +1703,7 @@ begin
if (Src[1]='/') then begin
// comment start -> read til line end
inc(Src);
while not (Src^ in [#10,#13]) do
while not (Src^ in [#0,#10,#13]) do
inc(Src);
end else
break;
@ -1798,9 +1798,10 @@ begin
'''':
begin
inc(Src);
while (Src^<>'''') do
while not (Src^ in ['''',#0]) do
inc(Src);
if Src^='''' then
inc(Src);
inc(Src);
end;
else
break;
@ -1810,7 +1811,7 @@ begin
'$': // hex constant
begin
inc(Src);
while (IsHexNumberChar[Src^]) do
while IsHexNumberChar[Src^] do
inc(Src);
end;
'&': // octal constant
@ -1848,7 +1849,7 @@ begin
if (Src[1]='*') then begin
// compiler directive -> read til comment end
inc(Src,2);
while (Src^<>'*') or (Src[1]<>')') do
while (Src^<>#0) and ((Src^<>'*') or (Src[1]<>')')) do
inc(Src);
inc(Src,2);
end else

143
components/codetools/codetoolscfgscript.pas
View File

@ -81,7 +81,7 @@ const
type
TCTCfgScriptStackItem = record
Typ: TCTCfgScriptStackItemType;
StartPos: integer;
StartPos: PChar;
Operand: TCTCfgScriptVariable;
end;
PCTCfgScriptStackItem = ^TCTCfgScriptStackItem;
@ -98,7 +98,7 @@ type
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Push(Typ: TCTCfgScriptStackItemType; StartPos: integer);
procedure Push(Typ: TCTCfgScriptStackItemType; const StartPos: PChar);
procedure Pop;
end;
@ -121,6 +121,8 @@ type
function GetErrors(Index: integer): TCTCfgScriptError;
procedure AddError(const aMsg: string; ErrorPos: PChar); overload;
procedure AddError(const aMsg: string); overload;
procedure ParseStatement;
procedure ParseBegin;
public
Src: PChar;
AtomStart: PChar;
@ -444,6 +446,85 @@ begin
AddError(aMsg,AtomStart);
end;
procedure TCTConfigScriptEngine.ParseStatement;
procedure ErrorUnexpectedAtom;
begin
if Src>AtomStart then
AddError('expected statement, but found '+GetAtom)
else
AddError('expected statement, but nothing found');
end;
var
IsKeyword: Boolean;
begin
debugln(['TCTConfigScriptEngine.ParseStatement Atom=',GetAtom]);
case AtomStart^ of
#0: ;
'a'..'z','A'..'Z':
begin
// identifier or keyword
IsKeyword:=false;
case UpChars[AtomStart^] of
'B':
if CompareIdentifiers('BEGIN',AtomStart)=0 then begin
IsKeyword:=true;
ParseBegin;
end;
'E':
case UpChars[AtomStart[1]] of
'L':
if CompareIdentifiers('ELSE',AtomStart)=0 then begin
IsKeyword:=true;
end;
'N':
if CompareIdentifiers('END',AtomStart)=0 then begin
IsKeyword:=true;
end;
end;
'I':
if CompareIdentifiers('IF',AtomStart)=0 then begin
IsKeyword:=true;
end;
'T':
if CompareIdentifiers('THEN',AtomStart)=0 then begin
IsKeyword:=true;
end;
end;
if not IsKeyword then begin
// parse assignment
debugln(['TCTConfigScriptEngine.Execute Identifier="',GetAtom,'" Variable exists=',Variables.GetVariable(AtomStart)<>nil]);
end;
end;
else
ErrorUnexpectedAtom;
end;
end;
procedure TCTConfigScriptEngine.ParseBegin;
var
BeginStart: PChar;
procedure AddMissingEnd;
begin
AddError('begin at '+PosToStr(BeginStart)+' without end');
end;
begin
BeginStart:=AtomStart;
FStack.Push(ctcssBegin,AtomStart);
repeat
ReadRawNextPascalAtom(Src,AtomStart);
if (Src=#0) then begin
AddMissingEnd;
end else if CompareIdentifiers('END',AtomStart)=0 then begin
FStack.Pop;
end;
ParseStatement;
until false;
end;
constructor TCTConfigScriptEngine.Create;
begin
FVariables:=TCTCfgScriptVariables.Create;
@ -471,14 +552,6 @@ end;
function TCTConfigScriptEngine.Execute(const Source: string;
StopAfterErrors: integer): boolean;
procedure ErrorUnexpectedAtom;
begin
AddError('expected statement, but found '+GetAtom);
end;
var
IsKeyword: Boolean;
begin
FStack.Clear;
ClearErrors;
@ -494,50 +567,12 @@ begin
SrcEnd:=SrcStart+length(Source);
Src:=SrcStart;
AtomStart:=Src;
// execute all statements
while true do begin
ReadRawNextPascalAtom(Src,AtomStart);
debugln(['TCTConfigScriptEngine.Execute Atom=',GetAtom]);
case AtomStart^ of
#0: break;
'a'..'z','A'..'Z':
begin
// identifier or keyword
IsKeyword:=false;
case UpChars[AtomStart^] of
'B':
if CompareIdentifiers('BEGIN',AtomStart)=0 then begin
IsKeyword:=true;
end;
'E':
case UpChars[AtomStart[1]] of
'L':
if CompareIdentifiers('ELSE',AtomStart)=0 then begin
IsKeyword:=true;
end;
'N':
if CompareIdentifiers('END',AtomStart)=0 then begin
IsKeyword:=true;
end;
end;
'I':
if CompareIdentifiers('IF',AtomStart)=0 then begin
IsKeyword:=true;
end;
'T':
if CompareIdentifiers('THEN',AtomStart)=0 then begin
IsKeyword:=true;
end;
end;
if not IsKeyword then begin
// parse assignment
debugln(['TCTConfigScriptEngine.Execute Identifier="',GetAtom,'" Variable exists=',Variables.GetVariable(AtomStart)<>nil]);
end;
end;
else
ErrorUnexpectedAtom;
end;
// execute all statements
ReadRawNextPascalAtom(Src,AtomStart);
while Src^<>#0 do begin
ParseStatement;
ReadRawNextPascalAtom(Src,AtomStart);
end;
Result:=ErrorCount=0;
@ -636,7 +671,7 @@ begin
end;
procedure TCTCfgScriptStack.Push(Typ: TCTCfgScriptStackItemType;
StartPos: integer);
const StartPos: PChar);
var
OldCapacity: LongInt;
Item: PCTCfgScriptStackItem;

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

@ -57,7 +57,6 @@ begin
Engine:=TCTConfigScriptEngine.Create;
try
Engine.Execute(Src);
except
on E: Exception do begin
writeln(E.Message);