mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-26 07:40:08 +02:00
codetools: fixed parsing non advanced records
git-svn-id: branches/fixes_2_0@61480 -
This commit is contained in:
mattias
parent
48c9baaca6
commit
18a0c25719
@ -208,7 +208,8 @@ type
|
||||
// keyword lists
|
||||
procedure BuildDefaultKeyWordFunctions; override;
|
||||
function ParseType(StartPos: integer): boolean;
|
||||
function ParseInnerClass(StartPos: integer): boolean;
|
||||
function ParseInnerClass(StartPos: integer; ClassDesc: TCodeTreeNodeDesc): boolean;
|
||||
function ParseInnerBasicRecord(StartPos: integer): boolean;
|
||||
function UnexpectedKeyWord: boolean;
|
||||
function EndOfSourceExpected: boolean;
|
||||
// read functions
|
||||
@ -481,9 +482,9 @@ begin
|
||||
Result:=KeyWordFuncTypeDefault;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.ParseInnerClass(StartPos: integer
|
||||
): boolean;
|
||||
// KeyWordFunctions for parsing in a class/object/record/interface
|
||||
function TPascalParserTool.ParseInnerClass(StartPos: integer;
|
||||
ClassDesc: TCodeTreeNodeDesc): boolean;
|
||||
// KeyWordFunctions for parsing in a class/object/advrecord/interface
|
||||
var
|
||||
p: PChar;
|
||||
begin
|
||||
@ -503,7 +504,7 @@ begin
|
||||
';': exit(true);
|
||||
'C':
|
||||
case UpChars[p[1]] of
|
||||
'A': if CompareSrcIdentifiers(p,'CASE') then exit(KeyWordFuncTypeRecordCase);
|
||||
'A': if (ClassDesc=ctnRecordType) and CompareSrcIdentifiers(p,'CASE') then exit(KeyWordFuncTypeRecordCase);
|
||||
'L': if CompareSrcIdentifiers(p,'CLASS') then exit(KeyWordFuncClassClass);
|
||||
'O': if CompareSrcIdentifiers(p,'CONSTRUCTOR') then exit(KeyWordFuncClassMethod)
|
||||
else if CompareSrcIdentifiers(p,'CONST') then exit(KeyWordFuncClassConstSection);
|
||||
@ -530,7 +531,8 @@ begin
|
||||
case UpChars[p[3]] of
|
||||
'C': if CompareSrcIdentifiers(p,'PROCEDURE') then exit(KeyWordFuncClassMethod);
|
||||
'P': if CompareSrcIdentifiers(p,'PROPERTY') then exit(KeyWordFuncClassProperty);
|
||||
'T': if CompareSrcIdentifiers(p,'PROTECTED') then exit(KeyWordFuncClassSection);
|
||||
'T': if (ClassDesc<>ctnRecordType) and CompareSrcIdentifiers(p,'PROTECTED') then
|
||||
exit(KeyWordFuncClassSection);
|
||||
end;
|
||||
end;
|
||||
'U':
|
||||
@ -562,6 +564,35 @@ begin
|
||||
Result:=KeyWordFuncClassIdentifier;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.ParseInnerBasicRecord(StartPos: integer): boolean;
|
||||
// KeyWordFunctions for parsing in a *non* advanced record
|
||||
var
|
||||
p: PChar;
|
||||
begin
|
||||
if StartPos>SrcLen then exit(false);
|
||||
p:=@Src[StartPos];
|
||||
case UpChars[p^] of
|
||||
'[':
|
||||
begin
|
||||
ReadAttribute;
|
||||
exit(true);
|
||||
end;
|
||||
'(':
|
||||
begin
|
||||
ReadTilBracketClose(true);
|
||||
exit(true);
|
||||
end;
|
||||
';': exit(true);
|
||||
'C':
|
||||
case UpChars[p[1]] of
|
||||
'A': if CompareSrcIdentifiers(p,'CASE') then exit(KeyWordFuncTypeRecordCase);
|
||||
end;
|
||||
'E':
|
||||
if CompareSrcIdentifiers(p,'END') then exit(false);
|
||||
end;
|
||||
Result:=KeyWordFuncClassIdentifier;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.UnexpectedKeyWord: boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
@ -4425,7 +4456,7 @@ begin
|
||||
if CurPos.Flag<>cafSemicolon then begin
|
||||
// parse till "end" of interface/dispinterface/objcprotocol
|
||||
repeat
|
||||
if not ParseInnerClass(CurPos.StartPos) then
|
||||
if not ParseInnerClass(CurPos.StartPos,IntfDesc) then
|
||||
begin
|
||||
if CurPos.Flag<>cafEnd then
|
||||
SaveRaiseStringExpectedButAtomFound(20170421195747,'end');
|
||||
@ -4503,17 +4534,20 @@ var
|
||||
IsForward: Boolean;
|
||||
ClassDesc: TCodeTreeNodeDesc;
|
||||
ClassNode: TCodeTreeNode;
|
||||
IsHelper: Boolean;
|
||||
IsHelper, IsBasicRecord: Boolean;
|
||||
HelperForNode: TCodeTreeNode;
|
||||
begin
|
||||
//debugln(['TPascalParserTool.KeyWordFuncTypeClass START ',GetAtom,' ',CleanPosToStr(CurPos.StartPos),' ',CurNode.DescAsString]);
|
||||
// class or 'class of' start found
|
||||
IsBasicRecord:=false;
|
||||
if UpAtomIs('CLASS') then
|
||||
ClassDesc:=ctnClass
|
||||
else if UpAtomIs('OBJECT') then
|
||||
ClassDesc:=ctnObject
|
||||
else if UpAtomIs('RECORD') then
|
||||
ClassDesc:=ctnRecordType
|
||||
else if UpAtomIs('RECORD') then begin
|
||||
ClassDesc:=ctnRecordType;
|
||||
IsBasicRecord:=not (cmsAdvancedRecords in Scanner.CompilerModeSwitches);
|
||||
end
|
||||
else if UpAtomIs('OBJCCLASS') then
|
||||
ClassDesc:=ctnObjCClass
|
||||
else if UpAtomIs('OBJCCATEGORY') then
|
||||
@ -4560,22 +4594,18 @@ begin
|
||||
SaveRaiseCharExpectedButAtomFound(20170421195756,';');
|
||||
end else begin
|
||||
if CurPos.Flag=cafWord then begin
|
||||
if UpAtomIs('SEALED') then begin
|
||||
while UpAtomIs('SEALED') do begin
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnClassSealed;
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
ReadNextAtom;
|
||||
end;
|
||||
end else if UpAtomIs('ABSTRACT') then begin
|
||||
while UpAtomIs('ABSTRACT') do begin
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnClassAbstract;
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
ReadNextAtom;
|
||||
end;
|
||||
if (ClassDesc=ctnClass) and UpAtomIs('SEALED') then begin
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnClassSealed;
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
ReadNextAtom;
|
||||
end else if (ClassDesc=ctnClass) and UpAtomIs('ABSTRACT') then begin
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnClassAbstract;
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
ReadNextAtom;
|
||||
end;
|
||||
if UpAtomIs('EXTERNAL') then begin
|
||||
if (ClassDesc in [ctnObjCClass,ctnObjCCategory])
|
||||
@ -4663,16 +4693,29 @@ begin
|
||||
CurNode.Desc:=ctnClassPublic;
|
||||
CurNode.StartPos:=LastAtoms.GetPriorAtom.EndPos;
|
||||
// parse till "end" of class/object
|
||||
repeat
|
||||
//DebugLn(['TPascalParserTool.KeyWordFuncTypeClass Atom=',GetAtom,' ',CurPos.StartPos>=ClassNode.EndPos]);
|
||||
if not ParseInnerClass(CurPos.StartPos) then
|
||||
begin
|
||||
if CurPos.Flag<>cafEnd then
|
||||
SaveRaiseStringExpectedButAtomFound(20170421195803,'end');
|
||||
break;
|
||||
end;
|
||||
ReadNextAtom;
|
||||
until false;
|
||||
if IsBasicRecord then begin
|
||||
repeat
|
||||
//DebugLn(['TPascalParserTool.KeyWordFuncTypeClass Atom=',GetAtom,' ',CurPos.StartPos>=ClassNode.EndPos]);
|
||||
if not ParseInnerBasicRecord(CurPos.StartPos) then
|
||||
begin
|
||||
if CurPos.Flag<>cafEnd then
|
||||
SaveRaiseStringExpectedButAtomFound(20190626160145,'end');
|
||||
break;
|
||||
end;
|
||||
ReadNextAtom;
|
||||
until false;
|
||||
end else begin
|
||||
repeat
|
||||
//DebugLn(['TPascalParserTool.KeyWordFuncTypeClass Atom=',GetAtom,' ',CurPos.StartPos>=ClassNode.EndPos]);
|
||||
if not ParseInnerClass(CurPos.StartPos,ClassDesc) then
|
||||
begin
|
||||
if CurPos.Flag<>cafEnd then
|
||||
SaveRaiseStringExpectedButAtomFound(20170421195803,'end');
|
||||
break;
|
||||
end;
|
||||
ReadNextAtom;
|
||||
until false;
|
||||
end;
|
||||
// end last sub section
|
||||
if CurNode.Desc in AllClassSubSections then begin
|
||||
CurNode.EndPos:=CurPos.StartPos;
|
||||
|
||||
@ -1,14 +1,14 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="11"/>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<CompatibilityMode Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InIDEConfig"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="runtestscodetools"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
|
||||
@ -44,6 +44,7 @@ type
|
||||
published
|
||||
procedure TestAtomRing;
|
||||
procedure TestRecord_ClassOperators;
|
||||
procedure TestRecord_Nonkeywords;
|
||||
procedure TestDeprecated;
|
||||
procedure TestMissingGenericKeywordObjFPCFail;
|
||||
procedure TestParseGenericsDelphi;
|
||||
@ -323,6 +324,7 @@ procedure TTestPascalParser.TestRecord_ClassOperators;
|
||||
begin
|
||||
StartProgram;
|
||||
Add([
|
||||
'{$modeswitch advancedrecords}',
|
||||
'type',
|
||||
' TFlag = (flag1);',
|
||||
'{$Define FPC_HAS_MANAGEMENT_OPERATORS}',
|
||||
@ -376,6 +378,21 @@ begin
|
||||
ParseModule;
|
||||
end;
|
||||
|
||||
procedure TTestPascalParser.TestRecord_Nonkeywords;
|
||||
begin
|
||||
StartProgram;
|
||||
Add([
|
||||
'type',
|
||||
' t = record',
|
||||
' public: word;',
|
||||
' private: word;',
|
||||
' protected: word;',
|
||||
' published: word;',
|
||||
' end;',
|
||||
'begin']);
|
||||
ParseModule;
|
||||
end;
|
||||
|
||||
procedure TTestPascalParser.TestDeprecated;
|
||||
begin
|
||||
StartProgram;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user