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

MG: fixed keymapping of none

Browse Source 
git-svn-id: trunk@3347 -
This commit is contained in:
lazarus 2002-09-14 20:05:14 +00:00
parent 7ec8c949c3
commit ae98336c93
4 changed files with 325 additions and 156 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
components/codetools/customcodetool.pas
View File

@ -63,6 +63,9 @@ type
procedure BuildDefaultKeyWordFunctions; virtual; procedure BuildDefaultKeyWordFunctions; virtual;
procedure SetScanner(NewScanner: TLinkScanner); virtual; procedure SetScanner(NewScanner: TLinkScanner); virtual;
procedure DoDeleteNodes; virtual; procedure DoDeleteNodes; virtual;
procedure RaiseIdentExpectedButAtomFound;
procedure RaiseBracketOpenExpectedButAtomFound;
procedure RaiseBracketCloseExpectedButAtomFound;
protected protected
LastErrorMessage: string; LastErrorMessage: string;
LastErrorCurPos: TAtomPosition; LastErrorCurPos: TAtomPosition;
@ -454,6 +457,12 @@ begin
end; end;
function TCustomCodeTool.AtomIsIdentifier(ExceptionOnNotFound: boolean):boolean; function TCustomCodeTool.AtomIsIdentifier(ExceptionOnNotFound: boolean):boolean;
procedure RaiseIdentExpectedButEOFFound;
begin
SaveRaiseException(ctsIdentExpectedButEOFFound);
end;
begin begin
if CurPos.StartPos<=SrcLen then begin if CurPos.StartPos<=SrcLen then begin
if IsIdentStartChar[UpperSrc[CurPos.StartPos]] then begin if IsIdentStartChar[UpperSrc[CurPos.StartPos]] then begin
@ -462,19 +471,19 @@ begin
Result:=true Result:=true
else begin else begin
if ExceptionOnNotFound then if ExceptionOnNotFound then
SaveRaiseExceptionFmt(ctsIdentExpectedButKeyWordFound,[GetAtom]) RaiseIdentExpectedButAtomFound
else else
Result:=false; Result:=false;
end; end;
end else begin end else begin
if ExceptionOnNotFound then if ExceptionOnNotFound then
SaveRaiseExceptionFmt(ctsIdentExpectedButAtomFound,[GetAtom]) RaiseIdentExpectedButAtomFound
else else
Result:=false; Result:=false;
end; end;
end else begin end else begin
if ExceptionOnNotFound then if ExceptionOnNotFound then
SaveRaiseException(ctsIdentExpectedButEOFFound) RaiseIdentExpectedButEOFFound
else else
Result:=false; Result:=false;
end; end;
@ -1235,13 +1244,19 @@ begin
end; end;
procedure TCustomCodeTool.UndoReadNextAtom; procedure TCustomCodeTool.UndoReadNextAtom;
procedure RaiseUndoImpossible;
begin
RaiseException('TCustomCodeTool.UndoReadNextAtom impossible');
end;
begin begin
if LastAtoms.Count>0 then begin if LastAtoms.Count>0 then begin
NextPos:=CurPos; NextPos:=CurPos;
CurPos:=LastAtoms.GetValueAt(0); CurPos:=LastAtoms.GetValueAt(0);
LastAtoms.UndoLastAdd; LastAtoms.UndoLastAdd;
end else end else
RaiseException('TCustomCodeTool.UndoReadNextAtom impossible'); RaiseUndoImpossible;
end; end;
function TCustomCodeTool.ReadTilBracketClose( function TCustomCodeTool.ReadTilBracketClose(
@ -1249,6 +1264,15 @@ function TCustomCodeTool.ReadTilBracketClose(
// reads code brackets (not comment brackets) // reads code brackets (not comment brackets)
var CloseBracket, AntiCloseBracket: TCommonAtomFlag; var CloseBracket, AntiCloseBracket: TCommonAtomFlag;
Start: TAtomPosition; Start: TAtomPosition;
procedure RaiseBracketNotFound;
begin
if CloseBracket=cafRoundBracketOpen then
SaveRaiseExceptionFmt(ctsBracketNotFound,['('])
else
SaveRaiseExceptionFmt(ctsBracketNotFound,['[']);
end;
begin begin
Result:=false; Result:=false;
if (Curpos.Flag=cafRoundBracketOpen) then begin if (Curpos.Flag=cafRoundBracketOpen) then begin
@ -1259,7 +1283,7 @@ begin
AntiCloseBracket:=cafRoundBracketClose; AntiCloseBracket:=cafRoundBracketClose;
end else begin end else begin
if ExceptionOnNotFound then if ExceptionOnNotFound then
SaveRaiseExceptionFmt(ctsBracketOpenExpectedButAtomFound,[GetAtom]); RaiseBracketOpenExpectedButAtomFound;
exit; exit;
end; end;
Start:=CurPos; Start:=CurPos;
@ -1271,10 +1295,7 @@ begin
then begin then begin
CurPos:=Start; CurPos:=Start;
if ExceptionOnNotFound then begin if ExceptionOnNotFound then begin
if CloseBracket=cafRoundBracketOpen then RaiseBracketNotFound;
SaveRaiseExceptionFmt(ctsBracketNotFound,['('])
else
SaveRaiseExceptionFmt(ctsBracketNotFound,['[']);
end; end;
exit; exit;
end; end;
@ -1290,6 +1311,15 @@ function TCustomCodeTool.ReadBackTilBracketOpen(
// reads code brackets (not comment brackets) // reads code brackets (not comment brackets)
var OpenBracket, AntiOpenBracket: TCommonAtomFlag; var OpenBracket, AntiOpenBracket: TCommonAtomFlag;
Start: TAtomPosition; Start: TAtomPosition;
procedure RaiseBracketNotFound;
begin
if OpenBracket=cafRoundBracketOpen then
SaveRaiseExceptionFmt(ctsBracketNotFound,['('])
else
SaveRaiseExceptionFmt(ctsBracketNotFound,['[']);
end;
begin begin
Result:=false; Result:=false;
if (CurPos.Flag=cafRoundBracketClose) then begin if (CurPos.Flag=cafRoundBracketClose) then begin
@ -1300,7 +1330,7 @@ begin
AntiOpenBracket:=cafRoundBracketOpen; AntiOpenBracket:=cafRoundBracketOpen;
end else begin end else begin
if ExceptionOnNotFound then if ExceptionOnNotFound then
SaveRaiseExceptionFmt(ctsBracketCloseExpectedButAtomFound,[GetAtom]); RaiseBracketCloseExpectedButAtomFound;
exit; exit;
end; end;
Start:=CurPos; Start:=CurPos;
@ -1311,10 +1341,7 @@ begin
or (CurPos.Flag in [AntiOpenBracket,cafEND,cafBegin]) then begin or (CurPos.Flag in [AntiOpenBracket,cafEND,cafBegin]) then begin
CurPos:=Start; CurPos:=Start;
if ExceptionOnNotFound then if ExceptionOnNotFound then
if OpenBracket=cafRoundBracketOpen then RaiseBracketNotFound;
SaveRaiseExceptionFmt(ctsBracketNotFound,['('])
else
SaveRaiseExceptionFmt(ctsBracketNotFound,['[']);
exit; exit;
end; end;
if CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose] then begin if CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose] then begin
@ -1391,14 +1418,25 @@ begin
end; end;
procedure TCustomCodeTool.MoveCursorToCleanPos(ACleanPos: PChar); procedure TCustomCodeTool.MoveCursorToCleanPos(ACleanPos: PChar);
procedure RaiseSrcEmpty;
begin
RaiseException('[TCustomCodeTool.MoveCursorToCleanPos - PChar] Src empty');
end;
procedure RaiseNotInSrc;
begin
RaiseException('[TCustomCodeTool.MoveCursorToCleanPos - PChar] '
+'CleanPos not in Src');
end;
var NewPos: integer; var NewPos: integer;
begin begin
if Src='' then if Src='' then
RaiseException('[TCustomCodeTool.MoveCursorToCleanPos - PChar] Src empty'); RaiseSrcEmpty;
NewPos:=Integer(ACleanPos)-Integer(@Src[1])+1; NewPos:=Integer(ACleanPos)-Integer(@Src[1])+1;
if (NewPos<1) or (NewPos>SrcLen) then if (NewPos<1) or (NewPos>SrcLen) then
RaiseException('[TCustomCodeTool.MoveCursorToCleanPos - PChar] ' RaiseNotInSrc;
+'CleanPos not in Src');
MoveCursorToCleanPos(NewPos); MoveCursorToCleanPos(NewPos);
end; end;
@ -1511,6 +1549,12 @@ end;
function TCustomCodeTool.FindDeepestNodeAtPos(StartNode: TCodeTreeNode; function TCustomCodeTool.FindDeepestNodeAtPos(StartNode: TCodeTreeNode;
P: integer; ExceptionOnNotFound: boolean): TCodeTreeNode; P: integer; ExceptionOnNotFound: boolean): TCodeTreeNode;
procedure RaiseNoNodeFoundAtCursor;
begin
SaveRaiseException(ctsNoNodeFoundAtCursor);
end;
begin begin
if StartNode<>nil then begin if StartNode<>nil then begin
//writeln('SearchInNode ',NodeDescriptionAsString(ANode.Desc), //writeln('SearchInNode ',NodeDescriptionAsString(ANode.Desc),
@ -1535,7 +1579,7 @@ begin
Result:=nil; Result:=nil;
if (Result=nil) and ExceptionOnNotFound then begin if (Result=nil) and ExceptionOnNotFound then begin
MoveCursorToCleanPos(P); MoveCursorToCleanPos(P);
SaveRaiseException(ctsNoNodeFoundAtCursor); RaiseNoNodeFoundAtCursor;
end; end;
end; end;
@ -1760,6 +1804,21 @@ begin
Tree.Clear; Tree.Clear;
end; end;
procedure TCustomCodeTool.RaiseIdentExpectedButAtomFound;
begin
SaveRaiseExceptionFmt(ctsIdentExpectedButKeyWordFound,[GetAtom])
end;
procedure TCustomCodeTool.RaiseBracketOpenExpectedButAtomFound;
begin
SaveRaiseExceptionFmt(ctsBracketOpenExpectedButAtomFound,[GetAtom]);
end;
procedure TCustomCodeTool.RaiseBracketCloseExpectedButAtomFound;
begin
SaveRaiseExceptionFmt(ctsBracketCloseExpectedButAtomFound,[GetAtom]);
end;
procedure TCustomCodeTool.ActivateGlobalWriteLock; procedure TCustomCodeTool.ActivateGlobalWriteLock;
begin begin
if Assigned(OnSetGlobalWriteLock) then OnSetGlobalWriteLock(true); if Assigned(OnSetGlobalWriteLock) then OnSetGlobalWriteLock(true);

84
components/codetools/linkscanner.pas
View File

@ -568,10 +568,16 @@ begin
end; end;
function TLinkScanner.LinkSize(Index: integer): integer; function TLinkScanner.LinkSize(Index: integer): integer;
begin
if (Index<0) or (Index>=LinkCount) then procedure IndexOutOfBounds;
begin
RaiseException('TLinkScanner.LinkSize index ' RaiseException('TLinkScanner.LinkSize index '
+IntToStr(Index)+' out of bounds: 0-'+IntToStr(LinkCount)); +IntToStr(Index)+' out of bounds: 0-'+IntToStr(LinkCount));
end;
begin
if (Index<0) or (Index>=LinkCount) then
IndexOutOfBounds;
if Index<LinkCount-1 then if Index<LinkCount-1 then
Result:=Links[Index+1].CleanedPos-Links[Index].CleanedPos Result:=Links[Index+1].CleanedPos-Links[Index].CleanedPos
else else
@ -626,6 +632,19 @@ begin
end; end;
function TLinkScanner.LinkIndexAtCleanPos(ACleanPos: integer): integer; function TLinkScanner.LinkIndexAtCleanPos(ACleanPos: integer): integer;
procedure ConsistencyError1;
begin
raise Exception.Create(
'TLinkScanner.LinkAtCleanPos Consistency-Error 1');
end;
procedure ConsistencyError2;
begin
raise Exception.Create(
'TLinkScanner.LinkAtCleanPos Consistency-Error 2');
end;
var l,r,m: integer; var l,r,m: integer;
begin begin
Result:=-1; Result:=-1;
@ -649,12 +668,10 @@ begin
Result:=m; Result:=m;
exit; exit;
end else end else
raise Exception.Create( ConsistencyError2;
'TLinkScanner.LinkAtCleanPos Consistency-Error 2');
end; end;
end; end;
raise Exception.Create( ConsistencyError1;
'TLinkScanner.LinkAtCleanPos Consistency-Error 1');
end; end;
function TLinkScanner.LinkIndexAtCursorPos(ACursorPos: integer; ACode: Pointer function TLinkScanner.LinkIndexAtCursorPos(ACursorPos: integer; ACode: Pointer
@ -678,12 +695,18 @@ begin
end; end;
procedure TLinkScanner.SetSource(ACode: pointer); procedure TLinkScanner.SetSource(ACode: pointer);
procedure RaiseUnableToGetCode;
begin
RaiseException('unable to get source with Code='+HexStr(Cardinal(Code),8));
end;
var SrcLog: TSourceLog; var SrcLog: TSourceLog;
begin begin
if Assigned(FOnGetSource) then begin if Assigned(FOnGetSource) then begin
SrcLog:=FOnGetSource(Self,ACode); SrcLog:=FOnGetSource(Self,ACode);
if SrcLog=nil then if SrcLog=nil then
RaiseException('unable to get source with Code='+HexStr(Cardinal(Code),8)); RaiseUnableToGetCode;
AddSourceChangeStep(ACode,SrcLog.ChangeStep); AddSourceChangeStep(ACode,SrcLog.ChangeStep);
Src:=SrcLog.Source; Src:=SrcLog.Source;
Code:=ACode; Code:=ACode;
@ -693,7 +716,7 @@ begin
SrcLen:=length(Src); SrcLen:=length(Src);
LastCleanSrcPos:=0; LastCleanSrcPos:=0;
end else begin end else begin
RaiseException('unable to get source with Code='+HexStr(Cardinal(Code),8)); RaiseUnableToGetCode;
end; end;
end; end;
@ -1042,13 +1065,19 @@ begin
end; end;
procedure TLinkScanner.AddSourceChangeStep(ACode: pointer;AChangeStep: integer); procedure TLinkScanner.AddSourceChangeStep(ACode: pointer;AChangeStep: integer);
procedure RaiseCodeNil;
begin
RaiseException('TLinkScanner.AddSourceChangeStep ACode=nil');
end;
var l,r,m: integer; var l,r,m: integer;
NewSrcChangeStep: PSourceChangeStep; NewSrcChangeStep: PSourceChangeStep;
c: pointer; c: pointer;
begin begin
//writeln('[TLinkScanner.AddSourceChangeStep] ',HexStr(Cardinal(ACode),8)); //writeln('[TLinkScanner.AddSourceChangeStep] ',HexStr(Cardinal(ACode),8));
if ACode=nil then if ACode=nil then
RaiseException('TLinkScanner.AddSourceChangeStep ACode=nil'); RaiseCodeNil;
l:=0; l:=0;
r:=FSourceChangeSteps.Count-1; r:=FSourceChangeSteps.Count-1;
m:=0; m:=0;
@ -1841,10 +1870,16 @@ end;
function TLinkScanner.EndifDirective: boolean; function TLinkScanner.EndifDirective: boolean;
// {$endif comment} // {$endif comment}
procedure RaiseAWithoutB;
begin
RaiseExceptionFmt(ctsAwithoutB,['$ENDIF','$IF'])
end;
begin begin
dec(IfLevel); dec(IfLevel);
if IfLevel<0 then if IfLevel<0 then
RaiseExceptionFmt(ctsAwithoutB,['$ENDIF','$IF']) RaiseAWithoutB
else if IfLevel<FSkipIfLevel then else if IfLevel<FSkipIfLevel then
FSkippingTillEndif:=false; FSkippingTillEndif:=false;
Result:=true; Result:=true;
@ -1852,9 +1887,15 @@ end;
function TLinkScanner.ElseDirective: boolean; function TLinkScanner.ElseDirective: boolean;
// {$else comment} // {$else comment}
procedure RaiseAWithoutB;
begin
RaiseExceptionFmt(ctsAwithoutB,['$ELSE','$IF']);
end;
begin begin
if IfLevel=0 then if IfLevel=0 then
RaiseExceptionFmt(ctsAwithoutB,['$ELSE','$IF']); RaiseAWithoutB;
if not FSkippingTillEndif then if not FSkippingTillEndif then
SkipTillEndifElse SkipTillEndifElse
else if IfLevel=FSkipIfLevel then else if IfLevel=FSkipIfLevel then
@ -2123,12 +2164,18 @@ end;
procedure TLinkScanner.PushIncludeLink(ACleanedPos, ASrcPos: integer; procedure TLinkScanner.PushIncludeLink(ACleanedPos, ASrcPos: integer;
ACode: pointer); ACode: pointer);
procedure RaiseIncludeCircleDetected;
begin
RaiseException(ctsIncludeCircleDetected);
end;
var NewLink: PSourceLink; var NewLink: PSourceLink;
i: integer; i: integer;
begin begin
for i:=0 to FIncludeStack.Count-1 do for i:=0 to FIncludeStack.Count-1 do
if PSourceLink(FIncludeStack[i])^.Code=ACode then if PSourceLink(FIncludeStack[i])^.Code=ACode then
RaiseException(ctsIncludeCircleDetected); RaiseIncludeCircleDetected;
NewLink:=PSourceLinkMemManager.NewPSourceLink; NewLink:=PSourceLinkMemManager.NewPSourceLink;
with NewLink^ do begin with NewLink^ do begin
CleanedPos:=ACleanedPos; CleanedPos:=ACleanedPos;
@ -2335,6 +2382,13 @@ end;
function TLinkScanner.CleanedPosToCursor(ACleanedPos: integer; function TLinkScanner.CleanedPosToCursor(ACleanedPos: integer;
var ACursorPos: integer; var ACode: Pointer): boolean; var ACursorPos: integer; var ACode: Pointer): boolean;
procedure ConsistencyCheckI(i: integer);
begin
raise Exception.Create(
'TLinkScanner.CleanedPosToCursor Consistency-Error '+IntToStr(i));
end;
var l,r,m: integer; var l,r,m: integer;
begin begin
Result:=(ACleanedPos>=1) and (ACleanedPos<=CleanedLen); Result:=(ACleanedPos>=1) and (ACleanedPos<=CleanedLen);
@ -2360,12 +2414,10 @@ begin
ACursorPos:=ACleanedPos-Links[m].CleanedPos+Links[m].SrcPos; ACursorPos:=ACleanedPos-Links[m].CleanedPos+Links[m].SrcPos;
exit; exit;
end else end else
raise Exception.Create( ConsistencyCheckI(2);
'TLinkScanner.CleanedPosToCursor Consistency-Error 2');
end; end;
end; end;
raise Exception.Create( ConsistencyCheckI(1);
'TLinkScanner.CleanedPosToCursor Consistency-Error 1');
end; end;
end; end;

299
components/codetools/pascalparsertool.pas
View File

@ -93,6 +93,11 @@ type
ExtractSearchPos: integer; ExtractSearchPos: integer;
ExtractFoundPos: integer; ExtractFoundPos: integer;
ExtractProcHeadPos: TProcHeadExtractPos; ExtractProcHeadPos: TProcHeadExtractPos;
procedure RaiseCharExpectedButAtomFound(c: char);
procedure RaiseStringExpectedButAtomFound(const s: string);
procedure RaiseUnexpectedKeyWord;
procedure RaiseIllegalQualifier;
protected
procedure InitExtraction; procedure InitExtraction;
function GetExtraction: string; function GetExtraction: string;
function ExtractStreamEndIsIdentChar: boolean; function ExtractStreamEndIsIdentChar: boolean;
@ -437,7 +442,7 @@ begin
exit; exit;
end; end;
ClearLastError; ClearLastError;
writeln('TPascalParserTool.BuildTree B OnlyInterfaceNeeded=',OnlyInterfaceNeeded,' ',TCodeBuffer(Scanner.MainCode).Filename); writeln('TPascalParserTool.BuildTree B OnlyIntf=',OnlyInterfaceNeeded,' ',TCodeBuffer(Scanner.MainCode).Filename);
//CheckHeap('TBasicCodeTool.BuildTree B '+IntToStr(GetMem_Cnt)); //CheckHeap('TBasicCodeTool.BuildTree B '+IntToStr(GetMem_Cnt));
// scan code // scan code
@ -467,13 +472,13 @@ begin
AtomIsIdentifier(true); AtomIsIdentifier(true);
ReadNextAtom; // read ';' ReadNextAtom; // read ';'
if (CurPos.Flag<>cafSemicolon) then if (CurPos.Flag<>cafSemicolon) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
if CurSection=ctnUnit then begin if CurSection=ctnUnit then begin
ReadNextAtom; ReadNextAtom;
CurNode.EndPos:=CurPos.StartPos; CurNode.EndPos:=CurPos.StartPos;
EndChildNode; EndChildNode;
if not UpAtomIs('INTERFACE') then if not UpAtomIs('INTERFACE') then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['"interface"',GetAtom]); RaiseStringExpectedButAtomFound('"interface"');
CreateChildNode; CreateChildNode;
CurSection:=ctnInterface; CurSection:=ctnInterface;
CurNode.Desc:=CurSection; CurNode.Desc:=CurSection;
@ -522,6 +527,11 @@ procedure TPascalParserTool.BuildSubTreeForClass(ClassNode: TCodeTreeNode);
'TPascalParserTool.BuildSubTreeForClass:' 'TPascalParserTool.BuildSubTreeForClass:'
+' class/object keyword expected, but '+GetAtom+' found'); +' class/object keyword expected, but '+GetAtom+' found');
end; end;
procedure RaiseStringConstantExpected;
begin
RaiseStringExpectedButAtomFound(ctsStringConstant);
end;
var OldPhase: integer; var OldPhase: integer;
begin begin
@ -568,14 +578,13 @@ begin
// read GUID // read GUID
ReadNextAtom; ReadNextAtom;
if not AtomIsStringConstant then if not AtomIsStringConstant then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound, RaiseStringConstantExpected;
[ctsStringConstant,GetAtom]);
ReadNextAtom; ReadNextAtom;
if CurPos.Flag<>cafEdgedBracketClose then if CurPos.Flag<>cafEdgedBracketClose then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[']',GetAtom]); RaiseCharExpectedButAtomFound(']');
ReadNextAtom; ReadNextAtom;
if (not (CurPos.Flag in [cafSemicolon,cafEnd])) then if (not (CurPos.Flag in [cafSemicolon,cafEnd])) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
CurNode.EndPos:=CurPos.EndPos; CurNode.EndPos:=CurPos.EndPos;
EndChildNode; EndChildNode;
end else end else
@ -603,6 +612,14 @@ end;
procedure TPascalParserTool.BuildSubTreeForBeginBlock(BeginNode: TCodeTreeNode); procedure TPascalParserTool.BuildSubTreeForBeginBlock(BeginNode: TCodeTreeNode);
// reparse a quick parsed begin..end block and build the child nodes // reparse a quick parsed begin..end block and build the child nodes
// create nodes for 'with' and 'case' statements // create nodes for 'with' and 'case' statements
procedure RaiseBeginExpected;
begin
SaveRaiseException(
'TPascalParserTool.BuildSubTreeForBeginBlock: begin expected, but '
+GetAtom+' found');
end;
var MaxPos, OldPhase: integer; var MaxPos, OldPhase: integer;
begin begin
OldPhase:=CurrentPhase; OldPhase:=CurrentPhase;
@ -623,9 +640,7 @@ begin
MoveCursorToNodeStart(BeginNode); MoveCursorToNodeStart(BeginNode);
ReadNextAtom; ReadNextAtom;
if CurPos.Flag<>cafBEGIN then if CurPos.Flag<>cafBEGIN then
SaveRaiseException( RaiseBeginExpected;
'TPascalParserTool.BuildSubTreeForBeginBlock: begin expected, but '
+GetAtom+' found');
if BeginNode.EndPos<SrcLen then if BeginNode.EndPos<SrcLen then
Maxpos:=BeginNode.EndPos Maxpos:=BeginNode.EndPos
else else
@ -707,7 +722,7 @@ begin
ReadNextAtom; ReadNextAtom;
end; end;
if CurPos.Flag<>cafColon then if CurPos.Flag<>cafColon then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[':',GetAtom]); RaiseCharExpectedButAtomFound(':');
// read type // read type
ReadVariableType; ReadVariableType;
Result:=true; Result:=true;
@ -727,7 +742,7 @@ begin
if CurPos.Flag=cafRECORD then if CurPos.Flag=cafRECORD then
Result:=KeyWordFuncClassVarTypeRecord Result:=KeyWordFuncClassVarTypeRecord
else begin else begin
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['"record"',GetAtom]); RaiseStringExpectedButAtomFound('"record"');
Result:=true; Result:=true;
end; end;
end; end;
@ -778,7 +793,7 @@ begin
ReadNextAtom; ReadNextAtom;
end; end;
if not UpAtomIs('OF') then if not UpAtomIs('OF') then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['[',GetAtom]); RaiseCharExpectedButAtomFound('[');
ReadNextAtom; ReadNextAtom;
Result:=ClassVarTypeKeyWordFuncList.DoItUpperCase(UpperSrc, Result:=ClassVarTypeKeyWordFuncList.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos); CurPos.StartPos,CurPos.EndPos-CurPos.StartPos);
@ -796,7 +811,7 @@ begin
CurNode.Desc:=ctnSetType; CurNode.Desc:=ctnSetType;
ReadNextAtom; ReadNextAtom;
if not UpAtomIs('OF') then if not UpAtomIs('OF') then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['"of"',GetAtom]); RaiseStringExpectedButAtomFound('"of"');
ReadNextAtom; ReadNextAtom;
if CurPos.StartPos>SrcLen then if CurPos.StartPos>SrcLen then
SaveRaiseException(ctsMissingEnumList); SaveRaiseException(ctsMissingEnumList);
@ -890,8 +905,7 @@ begin
if UpAtomIs('CLASS') or (UpAtomIs('STATIC')) then begin if UpAtomIs('CLASS') or (UpAtomIs('STATIC')) then begin
ReadNextAtom; ReadNextAtom;
if (not UpAtomIs('PROCEDURE')) and (not UpAtomIs('FUNCTION')) then begin if (not UpAtomIs('PROCEDURE')) and (not UpAtomIs('FUNCTION')) then begin
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound, RaiseStringExpectedButAtomFound(ctsProcedureOrFunction);
[ctsProcedureOrFunction,GetAtom]);
end; end;
end; end;
IsFunction:=UpAtomIs('FUNCTION'); IsFunction:=UpAtomIs('FUNCTION');
@ -1033,15 +1047,13 @@ begin
// read next parameter // read next parameter
if (CurPos.StartPos>SrcLen) then if (CurPos.StartPos>SrcLen) then
if ExceptionOnError then if ExceptionOnError then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound, RaiseCharExpectedButAtomFound(CloseBracket)
[CloseBracket,GetAtom])
else exit; else exit;
if (CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose]) then if (CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose]) then
break; break;
if (CurPos.Flag<>cafSemicolon) then if (CurPos.Flag<>cafSemicolon) then
if ExceptionOnError then if ExceptionOnError then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound, RaiseCharExpectedButAtomFound(CloseBracket)
[CloseBracket,GetAtom])
else exit; else exit;
if not Extract then if not Extract then
ReadNextAtom ReadNextAtom
@ -1052,7 +1064,7 @@ begin
if (CloseBracket<>#0) then begin if (CloseBracket<>#0) then begin
if Src[CurPos.StartPos]<>CloseBracket then begin if Src[CurPos.StartPos]<>CloseBracket then begin
if ExceptionOnError then if ExceptionOnError then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[CloseBracket,GetAtom]) RaiseCharExpectedButAtomFound(CloseBracket)
else else
exit; exit;
end; end;
@ -1084,7 +1096,7 @@ begin
if not Extract then ReadNextAtom else ExtractNextAtom(copying,Attr); if not Extract then ReadNextAtom else ExtractNextAtom(copying,Attr);
if not UpAtomIs('OF') then if not UpAtomIs('OF') then
if ExceptionOnError then if ExceptionOnError then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['"of"',GetAtom]) RaiseStringExpectedButAtomFound('"of"')
else exit; else exit;
if not Extract then ReadNextAtom else ExtractNextAtom(copying,Attr); if not Extract then ReadNextAtom else ExtractNextAtom(copying,Attr);
if UpAtomIs('CONST') then begin if UpAtomIs('CONST') then begin
@ -1130,7 +1142,7 @@ begin
end; end;
end else begin end else begin
if ExceptionOnError then if ExceptionOnError then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]) RaiseStringExpectedButAtomFound(ctsIdentifier)
else exit; else exit;
end; end;
Result:=true; Result:=true;
@ -1166,6 +1178,13 @@ function TPascalParserTool.ReadTilProcedureHeadEnd(
external <id or number> index <id>; external <id or number> index <id>;
[alias: <string constant>] [alias: <string constant>]
} }
procedure RaiseKeyWordExampleExpected;
begin
SaveRaiseExceptionFmt(
ctsKeywordExampleExpectedButAtomFound,['alias',GetAtom]);
end;
var IsSpecifier: boolean; var IsSpecifier: boolean;
Attr: TProcHeadAttributes; Attr: TProcHeadAttributes;
begin begin
@ -1204,7 +1223,7 @@ begin
ReadNextAtom; ReadNextAtom;
end else begin end else begin
if (Scanner.CompilerMode<>cmDelphi) then if (Scanner.CompilerMode<>cmDelphi) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[':',GetAtom]) RaiseCharExpectedButAtomFound(':')
else begin else begin
// Delphi Mode // Delphi Mode
if CurPos.Flag=cafEqual then begin if CurPos.Flag=cafEqual then begin
@ -1219,10 +1238,10 @@ begin
if UpAtomIs('OF') then begin if UpAtomIs('OF') then begin
// read 'of object' // read 'of object'
if not (pphIsType in ParseAttr) then if not (pphIsType in ParseAttr) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
ReadNextAtom; ReadNextAtom;
if not UpAtomIs('OBJECT') then if not UpAtomIs('OBJECT') then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['"object"',GetAtom]); RaiseStringExpectedButAtomFound('"object"');
ReadNextAtom; ReadNextAtom;
end; end;
// read procedures/method specifiers // read procedures/method specifiers
@ -1262,30 +1281,27 @@ begin
repeat repeat
ReadNextAtom; ReadNextAtom;
if not (CurPos.Flag in AllCommonAtomWords) then if not (CurPos.Flag in AllCommonAtomWords) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound, RaiseStringExpectedButAtomFound(ctsKeyword);
[ctsKeyword,GetAtom]);
if not IsKeyWordProcedureBracketSpecifier.DoItUppercase(UpperSrc, if not IsKeyWordProcedureBracketSpecifier.DoItUppercase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
then then
SaveRaiseExceptionFmt( RaiseKeyWordExampleExpected;
ctsKeywordExampleExpectedButAtomFound,['alias',GetAtom]);
if UpAtomIs('INTERNPROC') then if UpAtomIs('INTERNPROC') then
HasForwardModifier:=true; HasForwardModifier:=true;
ReadNextAtom; ReadNextAtom;
if CurPos.Flag in [cafColon,cafEdgedBracketClose] then if CurPos.Flag in [cafColon,cafEdgedBracketClose] then
break; break;
if CurPos.Flag<>cafComma then if CurPos.Flag<>cafComma then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[':',GetAtom]); RaiseCharExpectedButAtomFound(':');
until false; until false;
if CurPos.Flag=cafColon then begin if CurPos.Flag=cafColon then begin
ReadNextAtom; ReadNextAtom;
if (not AtomIsStringConstant) and (not AtomIsIdentifier(false)) then if (not AtomIsStringConstant) and (not AtomIsIdentifier(false)) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound, RaiseStringExpectedButAtomFound(ctsStringConstant);
[ctsStringConstant,GetAtom]);
ReadConstant(true,false,[]); ReadConstant(true,false,[]);
end; end;
if CurPos.Flag<>cafEdgedBracketClose then if CurPos.Flag<>cafEdgedBracketClose then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[']',GetAtom]); RaiseCharExpectedButAtomFound(']');
ReadNextAtom; ReadNextAtom;
if CurPos.Flag=cafEND then begin if CurPos.Flag=cafEND then begin
UndoReadNextAtom; UndoReadNextAtom;
@ -1302,7 +1318,7 @@ begin
end; end;
if CurPos.Flag<>cafSemicolon then begin if CurPos.Flag<>cafSemicolon then begin
if (Scanner.CompilerMode<>cmDelphi) then if (Scanner.CompilerMode<>cmDelphi) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
// Delphi allows procs without ending semicolon // Delphi allows procs without ending semicolon
UndoReadNextAtom; // unread unknown atom UndoReadNextAtom; // unread unknown atom
if CurPos.Flag=cafSemicolon then if CurPos.Flag=cafSemicolon then
@ -1333,7 +1349,7 @@ begin
if AtomIsKeyWord and (not IsKeyWordInConstAllowed.DoItUppercase(UpperSrc, if AtomIsKeyWord and (not IsKeyWordInConstAllowed.DoItUppercase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)) then begin CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)) then begin
if ExceptionOnError then if ExceptionOnError then
SaveRaiseExceptionFmt(ctsUnexpectedKeyword,[GetAtom]) RaiseUnexpectedKeyWord
else exit; else exit;
end; end;
if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr); if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr);
@ -1353,12 +1369,12 @@ begin
if (BracketType=cafRoundBracketOpen) if (BracketType=cafRoundBracketOpen)
and (CurPos.Flag<>cafRoundBracketClose) then and (CurPos.Flag<>cafRoundBracketClose) then
if ExceptionOnError then if ExceptionOnError then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['(',GetAtom]) RaiseCharExpectedButAtomFound('(')
else exit; else exit;
if (BracketType=cafEdgedBracketOpen) if (BracketType=cafEdgedBracketOpen)
and (CurPos.Flag<>cafEdgedBracketClose) then and (CurPos.Flag<>cafEdgedBracketClose) then
if ExceptionOnError then if ExceptionOnError then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['[',GetAtom]) RaiseCharExpectedButAtomFound('[')
else exit; else exit;
if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr); if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr);
end; end;
@ -1384,7 +1400,7 @@ begin
if not ReadConstant(ExceptionOnError,Extract,Attr) then exit; if not ReadConstant(ExceptionOnError,Extract,Attr) then exit;
if (c='(') and (CurPos.Flag<>cafRoundBracketClose) then if (c='(') and (CurPos.Flag<>cafRoundBracketClose) then
if ExceptionOnError then if ExceptionOnError then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[')',GetAtom]) RaiseCharExpectedButAtomFound(')')
else exit; else exit;
if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr); if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr);
if WordIsTermOperator.DoItUpperCase(UpperSrc, if WordIsTermOperator.DoItUpperCase(UpperSrc,
@ -1409,7 +1425,7 @@ begin
if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr); if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr);
end else if (CurPos.Flag<>cafEdgedBracketClose) then begin end else if (CurPos.Flag<>cafEdgedBracketClose) then begin
if ExceptionOnError then if ExceptionOnError then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[']',GetAtom]) RaiseCharExpectedButAtomFound(']')
else exit; else exit;
end; end;
until false; until false;
@ -1431,13 +1447,13 @@ begin
end; end;
else else
if ExceptionOnError then if ExceptionOnError then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsConstant,GetAtom]) RaiseStringExpectedButAtomFound(ctsConstant)
else exit; else exit;
end; end;
end else end else
// syntax error // syntax error
if ExceptionOnError then if ExceptionOnError then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsConstant,GetAtom]) RaiseStringExpectedButAtomFound(ctsConstant)
else exit; else exit;
end; end;
Result:=true; Result:=true;
@ -1463,15 +1479,14 @@ begin
ReadNextAtom; ReadNextAtom;
if not AtomIsStringConstant then if not AtomIsStringConstant then
if ExceptionOnError then if ExceptionOnError then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound, RaiseStringExpectedButAtomFound(ctsStringConstant)
[ctsStringConstant,GetAtom])
else exit; else exit;
ReadNextAtom; ReadNextAtom;
end; end;
if CurPos.Flag=cafSemicolon then break; if CurPos.Flag=cafSemicolon then break;
if CurPos.Flag<>cafComma then if CurPos.Flag<>cafComma then
if ExceptionOnError then if ExceptionOnError then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]) RaiseCharExpectedButAtomFound(';')
else exit; else exit;
until (CurPos.StartPos>SrcLen); until (CurPos.StartPos>SrcLen);
CurNode.EndPos:=CurPos.EndPos; CurNode.EndPos:=CurPos.EndPos;
@ -1499,7 +1514,7 @@ begin
break; break;
if AtomIs('..') then begin if AtomIs('..') then begin
if RangeOpFound then if RangeOpFound then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
RangeOpFound:=true; RangeOpFound:=true;
end else if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then end else if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then
ReadTilBracketClose(ExceptionOnError); ReadTilBracketClose(ExceptionOnError);
@ -1525,6 +1540,12 @@ function TPascalParserTool.KeyWordFuncClassProperty: boolean;
property specifiers with parameters: property specifiers with parameters:
index <id or number>, read <id>, write <id>, implements <id>, stored <id> index <id or number>, read <id>, write <id>, implements <id>, stored <id>
} }
procedure RaiseSemicolonAfterPropSpecMissing(const s: string);
begin
SaveRaiseExceptionFmt(ctsSemicolonAfterPropSpecMissing,[s,GetAtom]);
end;
begin begin
// create class method node // create class method node
CreateChildNode; CreateChildNode;
@ -1544,13 +1565,11 @@ begin
if UpAtomIs('DEFAULT') then begin if UpAtomIs('DEFAULT') then begin
ReadNextAtom; ReadNextAtom;
if CurPos.Flag<>cafSemicolon then if CurPos.Flag<>cafSemicolon then
SaveRaiseExceptionFmt(ctsSemicolonAfterPropSpecMissing, RaiseSemicolonAfterPropSpecMissing('default');
['default',GetAtom]);
end else if UpAtomIs('NODEFAULT') then begin end else if UpAtomIs('NODEFAULT') then begin
ReadNextAtom; ReadNextAtom;
if CurPos.Flag<>cafSemicolon then if CurPos.Flag<>cafSemicolon then
SaveRaiseExceptionFmt(ctsSemicolonAfterPropSpecMissing, RaiseSemicolonAfterPropSpecMissing('nodefault');
['nodefault',GetAtom]);
end else end else
UndoReadNextAtom; UndoReadNextAtom;
// close property // close property
@ -1576,6 +1595,12 @@ end;
function TPascalParserTool.KeyWordFuncSection: boolean; function TPascalParserTool.KeyWordFuncSection: boolean;
// parse section keywords (program, unit, interface, implementation, ...) // parse section keywords (program, unit, interface, implementation, ...)
procedure RaiseUnexpectedSectionKeyWord;
begin
SaveRaiseExceptionFmt(ctsUnknownSectionKeyword,[GetAtom]);
end;
begin begin
case CurSection of case CurSection of
ctnInterface, ctnProgram, ctnPackage, ctnLibrary, ctnUnit: ctnInterface, ctnProgram, ctnPackage, ctnLibrary, ctnUnit:
@ -1585,7 +1610,7 @@ begin
exit; exit;
end; end;
if not ((CurSection=ctnInterface) and UpAtomIs('IMPLEMENTATION')) then if not ((CurSection=ctnInterface) and UpAtomIs('IMPLEMENTATION')) then
SaveRaiseExceptionFmt(ctsUnexpectedKeyword,[GetAtom]); RaiseUnexpectedKeyWord;
// close interface section node // close interface section node
CurNode.EndPos:=CurPos.StartPos; CurNode.EndPos:=CurPos.StartPos;
EndChildNode; EndChildNode;
@ -1603,7 +1628,7 @@ begin
ctnImplementation: ctnImplementation:
begin begin
if not (UpAtomIs('INITIALIZATION') or UpAtomIs('FINALIZATION')) then if not (UpAtomIs('INITIALIZATION') or UpAtomIs('FINALIZATION')) then
SaveRaiseExceptionFmt(ctsUnexpectedKeyword,[GetAtom]); RaiseUnexpectedKeyWord;
// close implementation section node // close implementation section node
CurNode.EndPos:=CurPos.StartPos; CurNode.EndPos:=CurPos.StartPos;
EndChildNode; EndChildNode;
@ -1636,7 +1661,7 @@ begin
end; end;
else else
begin begin
SaveRaiseExceptionFmt(ctsUnknownSectionKeyword,[GetAtom]); RaiseUnexpectedSectionKeyWord;
Result:=false; Result:=false;
end; end;
end; end;
@ -1647,11 +1672,10 @@ function TPascalParserTool.KeyWordFuncEndPoint: boolean;
begin begin
if CurPos.Flag=cafPoint then begin if CurPos.Flag=cafPoint then begin
if not LastUpAtomIs(0,'END') then if not LastUpAtomIs(0,'END') then
SaveRaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]); RaiseIllegalQualifier;
UndoReadNextAtom; UndoReadNextAtom;
if CurNode.Desc in [ctnInterface] then if CurNode.Desc in [ctnInterface] then
SaveRaiseExceptionFmt( RaiseStringExpectedButAtomFound('"implementation"');
ctsStrExpectedButAtomFound,['"implementation"',GetAtom]);
if not (CurNode.Desc in [ctnImplementation,ctnInitialization, if not (CurNode.Desc in [ctnImplementation,ctnInitialization,
ctnFinalization,ctnProgram]) ctnFinalization,ctnProgram])
then begin then begin
@ -1660,7 +1684,7 @@ begin
end; end;
end else if CurPos.Flag=cafEND then begin end else if CurPos.Flag=cafEND then begin
if LastAtomIs(0,'@') then if LastAtomIs(0,'@') then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]); RaiseStringExpectedButAtomFound(ctsIdentifier);
if LastAtomIs(0,'@@') then begin if LastAtomIs(0,'@@') then begin
// for Delphi compatibility @@end is allowed // for Delphi compatibility @@end is allowed
Result:=true; Result:=true;
@ -1675,7 +1699,7 @@ begin
EndChildNode; EndChildNode;
ReadNextAtom; ReadNextAtom;
if CurPos.Flag<>cafPoint then if CurPos.Flag<>cafPoint then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['.',GetAtom]); RaiseCharExpectedButAtomFound('.');
CurSection:=ctnNone; CurSection:=ctnNone;
Result:=true; Result:=true;
end; end;
@ -1689,12 +1713,12 @@ var ChildCreated: boolean;
begin begin
if UpAtomIs('CLASS') then begin if UpAtomIs('CLASS') then begin
if CurSection<>ctnImplementation then if CurSection<>ctnImplementation then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]); RaiseStringExpectedButAtomFound(ctsIdentifier);
ReadNextAtom; ReadNextAtom;
if UpAtomIs('PROCEDURE') or UpAtomIs('FUNCTION') then if UpAtomIs('PROCEDURE') or UpAtomIs('FUNCTION') then
IsClassProc:=true IsClassProc:=true
else else
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['"procedure"',GetAtom]); RaiseStringExpectedButAtomFound('"procedure"');
end else end else
IsClassProc:=false; IsClassProc:=false;
ChildCreated:=true; ChildCreated:=true;
@ -1771,6 +1795,23 @@ var BlockType: TEndBlockType;
end; end;
end; end;
procedure RaiseUnknownBlockType;
begin
SaveRaiseException('internal codetool error in '
+'TPascalParserTool.ReadTilBlockEnd: unkown block type: '+GetAtom);
end;
procedure RaiseStrExpectedWithBlockStartHint(const Msg: string);
begin
SaveRaiseExceptionWithBlockStartHint(
Format(ctsStrExpectedButAtomFound,[Msg,GetAtom]));
end;
procedure RaiseUnexpectedKeywordInAsmBlock;
begin
SaveRaiseExceptionFmt(ctsUnexpectedKeywordInAsmBlock,[GetAtom]);
end;
begin begin
Result:=true; Result:=true;
TryType:=ttNone; TryType:=ttNone;
@ -1787,8 +1828,7 @@ begin
else if CurPos.Flag=cafRECORD then else if CurPos.Flag=cafRECORD then
BlockType:=ebtRecord BlockType:=ebtRecord
else else
SaveRaiseException('internal codetool error in ' RaiseUnknownBlockType;
+'TPascalParserTool.ReadTilBlockEnd: unkown block type: '+GetAtom);
BlockStartPos:=CurPos.StartPos; BlockStartPos:=CurPos.StartPos;
repeat repeat
ReadNextAtom; ReadNextAtom;
@ -1799,15 +1839,12 @@ begin
if (CurPos.Flag=cafEND) then begin if (CurPos.Flag=cafEND) then begin
if BlockType=ebtRepeat then if BlockType=ebtRepeat then
SaveRaiseExceptionWithBlockStartHint( RaiseStrExpectedWithBlockStartHint('"until"');
Format(ctsStrExpectedButAtomFound,['"until"',GetAtom]));
if (BlockType=ebtTry) and (TryType=ttNone) then if (BlockType=ebtTry) and (TryType=ttNone) then
SaveRaiseExceptionWithBlockStartHint( RaiseStrExpectedWithBlockStartHint('"finally"');
Format(ctsStrExpectedButAtomFound,['"finally"',GetAtom]));
ReadNextAtom; ReadNextAtom;
if (CurPos.Flag=cafPoint) and (BlockType<>ebtBegin) then begin if (CurPos.Flag=cafPoint) and (BlockType<>ebtBegin) then begin
SaveRaiseExceptionWithBlockStartHint( RaiseCharExpectedButAtomFound(';');
Format(ctsStrExpectedButAtomFound,[';','.']));
end; end;
UndoReadNextAtom; UndoReadNextAtom;
break; break;
@ -1816,28 +1853,25 @@ begin
or UpAtomIs('REPEAT') then or UpAtomIs('REPEAT') then
begin begin
if BlockType=ebtAsm then if BlockType=ebtAsm then
SaveRaiseExceptionFmt(ctsUnexpectedKeywordInAsmBlock,[GetAtom]); RaiseUnexpectedKeywordInAsmBlock;
if (BlockType<>ebtRecord) or (not UpAtomIs('CASE')) then if (BlockType<>ebtRecord) or (not UpAtomIs('CASE')) then
ReadTilBlockEnd(false,CreateNodes); ReadTilBlockEnd(false,CreateNodes);
end else if UpAtomIs('UNTIL') then begin end else if UpAtomIs('UNTIL') then begin
if BlockType=ebtRepeat then if BlockType=ebtRepeat then
break; break;
SaveRaiseExceptionWithBlockStartHint( RaiseStrExpectedWithBlockStartHint('"end"');
Format(ctsStrExpectedButAtomFound,['"end"',GetAtom]));
end else if UpAtomIs('FINALLY') then begin end else if UpAtomIs('FINALLY') then begin
if (BlockType=ebtTry) and (TryType=ttNone) then begin if (BlockType=ebtTry) and (TryType=ttNone) then begin
if StopOnBlockMiddlePart then break; if StopOnBlockMiddlePart then break;
TryType:=ttFinally; TryType:=ttFinally;
end else end else
SaveRaiseExceptionWithBlockStartHint( RaiseStrExpectedWithBlockStartHint('"end"');
Format(ctsStrExpectedButAtomFound,['"end"',GetAtom]));
end else if UpAtomIs('EXCEPT') then begin end else if UpAtomIs('EXCEPT') then begin
if (BlockType=ebtTry) and (TryType=ttNone) then begin if (BlockType=ebtTry) and (TryType=ttNone) then begin
if StopOnBlockMiddlePart then break; if StopOnBlockMiddlePart then break;
TryType:=ttExcept; TryType:=ttExcept;
end else end else
SaveRaiseExceptionWithBlockStartHint( RaiseStrExpectedWithBlockStartHint('"end"');
Format(ctsStrExpectedButAtomFound,['"end"',GetAtom]));
end else if CreateNodes and UpAtomIs('WITH') then begin end else if CreateNodes and UpAtomIs('WITH') then begin
ReadWithStatement(true,CreateNodes); ReadWithStatement(true,CreateNodes);
end else begin end else begin
@ -1848,7 +1882,7 @@ begin
if UnexpectedKeyWordInBeginBlock.DoItUppercase(UpperSrc, if UnexpectedKeyWordInBeginBlock.DoItUppercase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
then then
SaveRaiseExceptionFmt(ctsUnexpectedKeyword,[GetAtom]); RaiseUnexpectedKeyWord;
end; end;
end; end;
@ -1874,6 +1908,12 @@ var BlockType: TEndBlockType;
SaveRaiseExceptionFmt(ctsUnexpectedKeywordWhileReadingBackwards,[GetAtom]); SaveRaiseExceptionFmt(ctsUnexpectedKeywordWhileReadingBackwards,[GetAtom]);
end; end;
end; end;
procedure RaiseUnknownBlockType;
begin
SaveRaiseException('internal codetool error in '
+'TPascalParserTool.ReadBackTilBlockEnd: unkown block type: '+GetAtom);
end;
var OldAtom: TAtomPosition; var OldAtom: TAtomPosition;
begin begin
@ -1885,8 +1925,7 @@ begin
else if UpAtomIs('FINALLY') or UpAtomIs('EXCEPT') then else if UpAtomIs('FINALLY') or UpAtomIs('EXCEPT') then
BlockType:=ebtTry BlockType:=ebtTry
else else
SaveRaiseException('internal codetool error in ' RaiseUnknownBlockType;
+'TPascalParserTool.ReadBackTilBlockEnd: unkown block type: '+GetAtom);
repeat repeat
ReadPriorAtom; ReadPriorAtom;
if (CurPos.StartPos<1) then begin if (CurPos.StartPos<1) then begin
@ -2056,7 +2095,7 @@ begin
end; end;
if not UpAtomIs('DO') then begin if not UpAtomIs('DO') then begin
if ExceptionOnError then if ExceptionOnError then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['"do"',GetAtom]) RaiseStringExpectedButAtomFound('"do"')
else begin else begin
Result:=false; Result:=false;
exit; exit;
@ -2104,18 +2143,18 @@ begin
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)) CurPos.StartPos,CurPos.EndPos-CurPos.StartPos))
and AtomIsKeyWord and AtomIsKeyWord
then then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
until CurPos.Flag=cafSemicolon; until CurPos.Flag=cafSemicolon;
end; end;
// read ; // read ;
if CurPos.Flag<>cafSemicolon then if CurPos.Flag<>cafSemicolon then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
ReadNextAtom; ReadNextAtom;
if UpAtomIs('CVAR') then begin if UpAtomIs('CVAR') then begin
// for example: 'var a: char; cvar;' // for example: 'var a: char; cvar;'
ReadNextAtom; ReadNextAtom;
if CurPos.Flag<>cafSemicolon then if CurPos.Flag<>cafSemicolon then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
ReadNextAtom; ReadNextAtom;
end; end;
if UpAtomIs('PUBLIC') or UpAtomIs('EXTERNAL') then begin if UpAtomIs('PUBLIC') or UpAtomIs('EXTERNAL') then begin
@ -2135,12 +2174,11 @@ begin
// for example 'var a: char; public name 'b' ;' // for example 'var a: char; public name 'b' ;'
ReadNextAtom; ReadNextAtom;
if not AtomIsStringConstant then if not AtomIsStringConstant then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound, RaiseStringExpectedButAtomFound(ctsStringConstant);
[ctsStringConstant,GetAtom]);
ReadConstant(true,false,[]); ReadConstant(true,false,[]);
end; end;
if CurPos.Flag<>cafSemicolon then if CurPos.Flag<>cafSemicolon then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
end; end;
end else end else
UndoReadNextAtom; UndoReadNextAtom;
@ -2224,7 +2262,7 @@ function TPascalParserTool.KeyWordFuncType: boolean;
} }
begin begin
if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then
SaveRaiseExceptionFmt(ctsUnexpectedKeyword,[GetAtom]); RaiseUnexpectedKeyWord;
CreateChildNode; CreateChildNode;
CurNode.Desc:=ctnTypeSection; CurNode.Desc:=ctnTypeSection;
// read all type definitions Name = Type; // read all type definitions Name = Type;
@ -2235,14 +2273,14 @@ begin
CurNode.Desc:=ctnTypeDefinition; CurNode.Desc:=ctnTypeDefinition;
ReadNextAtom; ReadNextAtom;
if (CurPos.Flag<>cafEqual) then if (CurPos.Flag<>cafEqual) then
SaveRaiseExceptionFmt(ctsUnexpectedKeyword,['=',GetAtom]); RaiseCharExpectedButAtomFound('=');
// read type // read type
ReadNextAtom; ReadNextAtom;
TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos, TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos,
CurPos.EndPos-CurPos.StartPos); CurPos.EndPos-CurPos.StartPos);
// read ; // read ;
if CurPos.Flag<>cafSemicolon then if CurPos.Flag<>cafSemicolon then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
CurNode.EndPos:=CurPos.EndPos; CurNode.EndPos:=CurPos.EndPos;
EndChildNode; EndChildNode;
end else begin end else begin
@ -2274,7 +2312,7 @@ function TPascalParserTool.KeyWordFuncVar: boolean;
} }
begin begin
if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then
SaveRaiseExceptionFmt(ctsUnexpectedKeyword,[GetAtom]); RaiseUnexpectedKeyWord;
CreateChildNode; CreateChildNode;
CurNode.Desc:=ctnVarSection; CurNode.Desc:=ctnVarSection;
// read all variable definitions Name : Type; [cvar;] [public [name '']] // read all variable definitions Name : Type; [cvar;] [public [name '']]
@ -2295,7 +2333,7 @@ begin
ReadNextAtom; ReadNextAtom;
end; end;
if (CurPos.Flag<>cafColon) then if (CurPos.Flag<>cafColon) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[':',GetAtom]); RaiseCharExpectedButAtomFound(':');
// read type // read type
ReadVariableType; ReadVariableType;
end else begin end else begin
@ -2322,7 +2360,7 @@ function TPascalParserTool.KeyWordFuncConst: boolean;
} }
begin begin
if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then
SaveRaiseExceptionFmt(ctsUnexpectedKeyword,[GetAtom]); RaiseUnexpectedKeyWord;
CreateChildNode; CreateChildNode;
CurNode.Desc:=ctnConstSection; CurNode.Desc:=ctnConstSection;
// read all constants Name = <Const>; or Name : type = <Const>; // read all constants Name = <Const>; or Name : type = <Const>;
@ -2339,7 +2377,7 @@ begin
CurPos.EndPos-CurPos.StartPos); CurPos.EndPos-CurPos.StartPos);
end; end;
if (CurPos.Flag<>cafEqual) then if (CurPos.Flag<>cafEqual) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['=',GetAtom]); RaiseCharExpectedButAtomFound('=');
// read constant // read constant
repeat repeat
ReadNextAtom; ReadNextAtom;
@ -2349,8 +2387,7 @@ begin
and (not IsKeyWordInConstAllowed.DoItUppercase(UpperSrc, and (not IsKeyWordInConstAllowed.DoItUppercase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)) CurPos.StartPos,CurPos.EndPos-CurPos.StartPos))
and AtomIsKeyWord then and AtomIsKeyWord then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound, RaiseStringExpectedButAtomFound('constant');
['constant',GetAtom]);
until (CurPos.Flag in [cafSemicolon]); until (CurPos.Flag in [cafSemicolon]);
CurNode.EndPos:=CurPos.EndPos; CurNode.EndPos:=CurPos.EndPos;
EndChildNode; EndChildNode;
@ -2378,7 +2415,7 @@ function TPascalParserTool.KeyWordFuncResourceString: boolean;
} }
begin begin
if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then
SaveRaiseExceptionFmt(ctsUnexpectedKeyword,[GetAtom]); RaiseUnexpectedKeyWord;
CreateChildNode; CreateChildNode;
CurNode.Desc:=ctnResStrSection; CurNode.Desc:=ctnResStrSection;
// read all string constants Name = 'abc'; // read all string constants Name = 'abc';
@ -2389,17 +2426,17 @@ begin
CurNode.Desc:=ctnConstDefinition; CurNode.Desc:=ctnConstDefinition;
ReadNextAtom; ReadNextAtom;
if (CurPos.Flag<>cafEqual) then if (CurPos.Flag<>cafEqual) then
SaveRaiseExceptionFmt(ctsUnexpectedKeyword,['=',GetAtom]); RaiseCharExpectedButAtomFound('=');
// read string constant // read string constant
ReadNextAtom; ReadNextAtom;
if not AtomIsStringConstant then if not AtomIsStringConstant then
SaveRaiseExceptionFmt(ctsUnexpectedKeyword,[ctsStringConstant,GetAtom]); RaiseStringExpectedButAtomFound(ctsStringConstant);
ReadConstant(true,false,[]); ReadConstant(true,false,[]);
if UpAtomIs('DEPRECATED') then if UpAtomIs('DEPRECATED') then
ReadNextAtom; ReadNextAtom;
// read ; // read ;
if CurPos.Flag<>cafSemicolon then if CurPos.Flag<>cafSemicolon then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
CurNode.EndPos:=CurPos.EndPos; CurNode.EndPos:=CurPos.EndPos;
EndChildNode; EndChildNode;
end else begin end else begin
@ -2419,14 +2456,14 @@ function TPascalParserTool.KeyWordFuncLabel: boolean;
} }
begin begin
if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then
SaveRaiseExceptionFmt(ctsUnexpectedKeyword,[GetAtom]); RaiseUnexpectedKeyWord;
CreateChildNode; CreateChildNode;
CurNode.Desc:=ctnLabelSection; CurNode.Desc:=ctnLabelSection;
// read all constants // read all constants
repeat repeat
ReadNextAtom; // identifier or number ReadNextAtom; // identifier or number
if not AtomIsIdentifier(false) or AtomIsNumber then begin if not AtomIsIdentifier(false) or AtomIsNumber then begin
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]); RaiseStringExpectedButAtomFound(ctsIdentifier);
end; end;
CreateChildNode; CreateChildNode;
CurNode.Desc:=ctnLabelType; CurNode.Desc:=ctnLabelType;
@ -2436,7 +2473,7 @@ begin
if CurPos.Flag=cafSemicolon then begin if CurPos.Flag=cafSemicolon then begin
break; break;
end else if (CurPos.Flag<>cafComma) then begin end else if (CurPos.Flag<>cafComma) then begin
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
end; end;
until false; until false;
CurNode.EndPos:=CurPos.EndPos; CurNode.EndPos:=CurPos.EndPos;
@ -2449,7 +2486,7 @@ begin
ReadNextAtom; ReadNextAtom;
if not PackedTypesKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos, if not PackedTypesKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos,
CurPos.EndPos-CurPos.StartPos) then CurPos.EndPos-CurPos.StartPos) then
SaveRaiseExceptionFmt(ctsUnexpectedKeyword,['"record"',GetAtom]); RaiseStringExpectedButAtomFound('"record"');
Result:=TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos, Result:=TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos,
CurPos.EndPos-CurPos.StartPos); CurPos.EndPos-CurPos.StartPos);
end; end;
@ -2489,7 +2526,7 @@ begin
AtomIsIdentifier(true); AtomIsIdentifier(true);
ReadNextAtom; ReadNextAtom;
if CurPos.Flag<>cafSemicolon then if CurPos.Flag<>cafSemicolon then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
if ChildCreated then CurNode.Desc:=ctnClassOfType; if ChildCreated then CurNode.Desc:=ctnClassOfType;
end else if (CurPos.Flag=cafRoundBracketOpen) then begin end else if (CurPos.Flag=cafRoundBracketOpen) then begin
// read inheritage brackets // read inheritage brackets
@ -2547,12 +2584,12 @@ begin
EndChildNode; EndChildNode;
if (CurPos.Flag=cafEdgedBracketClose) then break; if (CurPos.Flag=cafEdgedBracketClose) then break;
if (CurPos.Flag<>cafComma) then if (CurPos.Flag<>cafComma) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[']',GetAtom]); RaiseCharExpectedButAtomFound(']');
until false; until false;
ReadNextAtom; ReadNextAtom;
end; end;
if not UpAtomIs('OF') then if not UpAtomIs('OF') then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['"of"',GetAtom]); RaiseStringExpectedButAtomFound('"of"');
ReadNextAtom; ReadNextAtom;
Result:=TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos, Result:=TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos,
CurPos.EndPos-CurPos.StartPos); CurPos.EndPos-CurPos.StartPos);
@ -2586,12 +2623,12 @@ begin
AtomIsIdentifier(true); AtomIsIdentifier(true);
ReadNextAtom; ReadNextAtom;
end else begin end else begin
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[':',GetAtom]); RaiseCharExpectedButAtomFound(':');
end; end;
end; end;
if UpAtomIs('OF') then begin if UpAtomIs('OF') then begin
if not ReadNextUpAtomIs('OBJECT') then if not ReadNextUpAtomIs('OBJECT') then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['"object"',GetAtom]); RaiseStringExpectedButAtomFound('"object"');
ReadNextAtom; ReadNextAtom;
end; end;
if (CurPos.Flag=cafEqual) if (CurPos.Flag=cafEqual)
@ -2614,7 +2651,7 @@ begin
UndoReadNextAtom; UndoReadNextAtom;
if (CurPos.Flag<>cafSemicolon) if (CurPos.Flag<>cafSemicolon)
and (Scanner.CompilerMode<>cmDelphi) then and (Scanner.CompilerMode<>cmDelphi) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
break; break;
end else begin end else begin
ReadNextAtom; ReadNextAtom;
@ -2623,13 +2660,13 @@ begin
break; break;
end; end;
if Scanner.CompilerMode<>cmDelphi then begin if Scanner.CompilerMode<>cmDelphi then begin
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
end else begin end else begin
// delphi allows proc modifiers without semicolons // delphi allows proc modifiers without semicolons
if not IsKeyWordProcedureTypeSpecifier.DoItUpperCase(UpperSrc, if not IsKeyWordProcedureTypeSpecifier.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) then CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) then
begin begin
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
end; end;
UndoReadNextAtom; UndoReadNextAtom;
end; end;
@ -2654,7 +2691,7 @@ begin
CreateChildNode; CreateChildNode;
CurNode.Desc:=ctnSetType; CurNode.Desc:=ctnSetType;
if not ReadNextUpAtomIs('OF') then if not ReadNextUpAtomIs('OF') then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['"of"',GetAtom]); RaiseStringExpectedButAtomFound('"of"');
ReadNextAtom; ReadNextAtom;
Result:=KeyWordFuncTypeDefault; Result:=KeyWordFuncTypeDefault;
CurNode.EndPos:=CurPos.EndPos; CurNode.EndPos:=CurPos.EndPos;
@ -2677,7 +2714,7 @@ function TPascalParserTool.KeyWordFuncTypeType: boolean;
// 'type identifier' // 'type identifier'
begin begin
if not LastAtomIs(0,'=') then if not LastAtomIs(0,'=') then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctnIdentifier,GetAtom]); RaiseStringExpectedButAtomFound(ctsIdentifier);
CreateChildNode; CreateChildNode;
CurNode.Desc:=ctnTypeType; CurNode.Desc:=ctnTypeType;
ReadNextAtom; ReadNextAtom;
@ -2807,7 +2844,7 @@ begin
end; end;
if (CurPos.Flag=cafRoundBracketClose) then break; if (CurPos.Flag=cafRoundBracketClose) then break;
if (CurPos.Flag<>cafComma) then if (CurPos.Flag<>cafComma) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[')',GetAtom]); RaiseCharExpectedButAtomFound(')');
until false; until false;
CurNode.EndPos:=CurPos.EndPos; CurNode.EndPos:=CurPos.EndPos;
ReadNextAtom; ReadNextAtom;
@ -2865,7 +2902,7 @@ begin
ReadNextAtom; ReadNextAtom;
if (CurPos.Flag=cafColon) then break; if (CurPos.Flag=cafColon) then break;
if (CurPos.Flag<>cafComma) then if (CurPos.Flag<>cafComma) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[':',GetAtom]); RaiseCharExpectedButAtomFound(':');
EndChildNode; // close variable EndChildNode; // close variable
ReadNextAtom; // read next variable name ReadNextAtom; // read next variable name
until false; until false;
@ -2901,7 +2938,7 @@ begin
ReadNextAtom; ReadNextAtom;
end; end;
if not UpAtomIs('OF') then // read 'of' if not UpAtomIs('OF') then // read 'of'
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['"of"',GetAtom]); RaiseStringExpectedButAtomFound('"of"');
// read all variants // read all variants
repeat repeat
ReadNextAtom; // read constant (variant identifier) ReadNextAtom; // read constant (variant identifier)
@ -2912,12 +2949,12 @@ begin
ReadConstant(true,false,[]); ReadConstant(true,false,[]);
if (CurPos.Flag=cafColon) then break; if (CurPos.Flag=cafColon) then break;
if (CurPos.Flag<>cafComma) then if (CurPos.Flag<>cafComma) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[':',GetAtom]); RaiseCharExpectedButAtomFound(':');
ReadNextAtom; ReadNextAtom;
until false; until false;
ReadNextAtom; // read '(' ReadNextAtom; // read '('
if (CurPos.Flag<>cafRoundBracketOpen) then if (CurPos.Flag<>cafRoundBracketOpen) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['(',GetAtom]); RaiseCharExpectedButAtomFound('(');
// read all variables // read all variables
ReadNextAtom; // read first variable name ReadNextAtom; // read first variable name
repeat repeat
@ -2938,7 +2975,7 @@ begin
ReadNextAtom; ReadNextAtom;
if (CurPos.Flag=cafColon) then break; if (CurPos.Flag=cafColon) then break;
if (CurPos.Flag<>cafComma) then if (CurPos.Flag<>cafComma) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,['","',GetAtom]); RaiseCharExpectedButAtomFound(',');
EndChildNode; EndChildNode;
ReadNextAtom; // read next variable name ReadNextAtom; // read next variable name
until false; until false;
@ -2951,11 +2988,11 @@ begin
end; end;
if (CurPos.Flag=cafRoundBracketClose) then break; if (CurPos.Flag=cafRoundBracketClose) then break;
if CurPos.Flag<>cafSemicolon then if CurPos.Flag<>cafSemicolon then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
ReadNextAtom; ReadNextAtom;
until false; until false;
if (CurPos.Flag<>cafRoundBracketClose) then if (CurPos.Flag<>cafRoundBracketClose) then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[')',GetAtom]); RaiseCharExpectedButAtomFound(')');
ReadNextAtom; ReadNextAtom;
if (CurPos.Flag in [cafEnd,cafRoundBracketClose]) then begin if (CurPos.Flag in [cafEnd,cafRoundBracketClose]) then begin
CurNode.EndPos:=CurPos.StartPos; CurNode.EndPos:=CurPos.StartPos;
@ -2963,7 +3000,7 @@ begin
break; break;
end; end;
if CurPos.Flag<>cafSemicolon then if CurPos.Flag<>cafSemicolon then
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); RaiseCharExpectedButAtomFound(';');
CurNode.EndPos:=CurPos.EndPos; CurNode.EndPos:=CurPos.EndPos;
EndChildNode; // close variant EndChildNode; // close variant
// read next variant // read next variant
@ -3059,6 +3096,26 @@ begin
end; end;
end; end;
procedure TPascalParserTool.RaiseCharExpectedButAtomFound(c: char);
begin
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[c,GetAtom]);
end;
procedure TPascalParserTool.RaiseStringExpectedButAtomFound(const s: string);
begin
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[s,GetAtom]);
end;
procedure TPascalParserTool.RaiseUnexpectedKeyWord;
begin
SaveRaiseExceptionFmt(ctsUnexpectedKeyword,[GetAtom]);
end;
procedure TPascalParserTool.RaiseIllegalQualifier;
begin
SaveRaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end;
procedure TPascalParserTool.InitExtraction; procedure TPascalParserTool.InitExtraction;
begin begin
if ExtractMemStream=nil then if ExtractMemStream=nil then

3
ide/keymapping.pp
View File

@ -335,7 +335,8 @@ begin
for i:=VK_IRREGULAR+33 to VK_IRREGULAR+255 do for i:=VK_IRREGULAR+33 to VK_IRREGULAR+255 do
VirtualKeyStrings.Add(KeyAndShiftStateToStr(i,[]),Pointer(i)); VirtualKeyStrings.Add(KeyAndShiftStateToStr(i,[]),Pointer(i));
end; end;
end; end else
exit;
Data:=VirtualKeyStrings.Data[s]; Data:=VirtualKeyStrings.Data[s];
if Data<>nil then if Data<>nil then
Result:=integer(Data); Result:=integer(Data);