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

codetools: fixed parsing non advanced records

Browse Source 
git-svn-id: branches/fixes_2_0@61480 -
This commit is contained in:
mattias 2019-06-26 14:09:51 +00:00
parent 48c9baaca6
commit 18a0c25719
3 changed files with 98 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
components/codetools/pascalparsertool.pas
View File

@ -208,7 +208,8 @@ type
// keyword lists // keyword lists
procedure BuildDefaultKeyWordFunctions; override; procedure BuildDefaultKeyWordFunctions; override;
function ParseType(StartPos: integer): boolean; 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 UnexpectedKeyWord: boolean;
function EndOfSourceExpected: boolean; function EndOfSourceExpected: boolean;
// read functions // read functions
@ -481,9 +482,9 @@ begin
Result:=KeyWordFuncTypeDefault; Result:=KeyWordFuncTypeDefault;
end; end;
function TPascalParserTool.ParseInnerClass(StartPos: integer function TPascalParserTool.ParseInnerClass(StartPos: integer;
): boolean; ClassDesc: TCodeTreeNodeDesc): boolean;
// KeyWordFunctions for parsing in a class/object/record/interface // KeyWordFunctions for parsing in a class/object/advrecord/interface
var var
p: PChar; p: PChar;
begin begin
@ -503,7 +504,7 @@ begin
';': exit(true); ';': exit(true);
'C': 'C':
case UpChars[p[1]] of 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); 'L': if CompareSrcIdentifiers(p,'CLASS') then exit(KeyWordFuncClassClass);
'O': if CompareSrcIdentifiers(p,'CONSTRUCTOR') then exit(KeyWordFuncClassMethod) 'O': if CompareSrcIdentifiers(p,'CONSTRUCTOR') then exit(KeyWordFuncClassMethod)
else if CompareSrcIdentifiers(p,'CONST') then exit(KeyWordFuncClassConstSection); else if CompareSrcIdentifiers(p,'CONST') then exit(KeyWordFuncClassConstSection);
@ -530,7 +531,8 @@ begin
case UpChars[p[3]] of case UpChars[p[3]] of
'C': if CompareSrcIdentifiers(p,'PROCEDURE') then exit(KeyWordFuncClassMethod); 'C': if CompareSrcIdentifiers(p,'PROCEDURE') then exit(KeyWordFuncClassMethod);
'P': if CompareSrcIdentifiers(p,'PROPERTY') then exit(KeyWordFuncClassProperty); '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;
end; end;
'U': 'U':
@ -562,6 +564,35 @@ begin
Result:=KeyWordFuncClassIdentifier; Result:=KeyWordFuncClassIdentifier;
end; 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; function TPascalParserTool.UnexpectedKeyWord: boolean;
begin begin
Result:=false; Result:=false;
@ -4425,7 +4456,7 @@ begin
if CurPos.Flag<>cafSemicolon then begin if CurPos.Flag<>cafSemicolon then begin
// parse till "end" of interface/dispinterface/objcprotocol // parse till "end" of interface/dispinterface/objcprotocol
repeat repeat
if not ParseInnerClass(CurPos.StartPos) then if not ParseInnerClass(CurPos.StartPos,IntfDesc) then
begin begin
if CurPos.Flag<>cafEnd then if CurPos.Flag<>cafEnd then
SaveRaiseStringExpectedButAtomFound(20170421195747,'end'); SaveRaiseStringExpectedButAtomFound(20170421195747,'end');
@ -4503,17 +4534,20 @@ var
IsForward: Boolean; IsForward: Boolean;
ClassDesc: TCodeTreeNodeDesc; ClassDesc: TCodeTreeNodeDesc;
ClassNode: TCodeTreeNode; ClassNode: TCodeTreeNode;
IsHelper: Boolean; IsHelper, IsBasicRecord: Boolean;
HelperForNode: TCodeTreeNode; HelperForNode: TCodeTreeNode;
begin begin
//debugln(['TPascalParserTool.KeyWordFuncTypeClass START ',GetAtom,' ',CleanPosToStr(CurPos.StartPos),' ',CurNode.DescAsString]); //debugln(['TPascalParserTool.KeyWordFuncTypeClass START ',GetAtom,' ',CleanPosToStr(CurPos.StartPos),' ',CurNode.DescAsString]);
// class or 'class of' start found // class or 'class of' start found
IsBasicRecord:=false;
if UpAtomIs('CLASS') then if UpAtomIs('CLASS') then
ClassDesc:=ctnClass ClassDesc:=ctnClass
else if UpAtomIs('OBJECT') then else if UpAtomIs('OBJECT') then
ClassDesc:=ctnObject ClassDesc:=ctnObject
else if UpAtomIs('RECORD') then else if UpAtomIs('RECORD') then begin
ClassDesc:=ctnRecordType ClassDesc:=ctnRecordType;
IsBasicRecord:=not (cmsAdvancedRecords in Scanner.CompilerModeSwitches);
end
else if UpAtomIs('OBJCCLASS') then else if UpAtomIs('OBJCCLASS') then
ClassDesc:=ctnObjCClass ClassDesc:=ctnObjCClass
else if UpAtomIs('OBJCCATEGORY') then else if UpAtomIs('OBJCCATEGORY') then
@ -4560,22 +4594,18 @@ begin
SaveRaiseCharExpectedButAtomFound(20170421195756,';'); SaveRaiseCharExpectedButAtomFound(20170421195756,';');
end else begin end else begin
if CurPos.Flag=cafWord then begin if CurPos.Flag=cafWord then begin
if UpAtomIs('SEALED') then begin if (ClassDesc=ctnClass) and UpAtomIs('SEALED') then begin
while UpAtomIs('SEALED') do begin CreateChildNode;
CreateChildNode; CurNode.Desc:=ctnClassSealed;
CurNode.Desc:=ctnClassSealed; CurNode.EndPos:=CurPos.EndPos;
CurNode.EndPos:=CurPos.EndPos; EndChildNode;
EndChildNode; ReadNextAtom;
ReadNextAtom; end else if (ClassDesc=ctnClass) and UpAtomIs('ABSTRACT') then begin
end; CreateChildNode;
end else if UpAtomIs('ABSTRACT') then begin CurNode.Desc:=ctnClassAbstract;
while UpAtomIs('ABSTRACT') do begin CurNode.EndPos:=CurPos.EndPos;
CreateChildNode; EndChildNode;
CurNode.Desc:=ctnClassAbstract; ReadNextAtom;
CurNode.EndPos:=CurPos.EndPos;
EndChildNode;
ReadNextAtom;
end;
end; end;
if UpAtomIs('EXTERNAL') then begin if UpAtomIs('EXTERNAL') then begin
if (ClassDesc in [ctnObjCClass,ctnObjCCategory]) if (ClassDesc in [ctnObjCClass,ctnObjCCategory])
@ -4663,16 +4693,29 @@ begin
CurNode.Desc:=ctnClassPublic; CurNode.Desc:=ctnClassPublic;
CurNode.StartPos:=LastAtoms.GetPriorAtom.EndPos; CurNode.StartPos:=LastAtoms.GetPriorAtom.EndPos;
// parse till "end" of class/object // parse till "end" of class/object
repeat if IsBasicRecord then begin
//DebugLn(['TPascalParserTool.KeyWordFuncTypeClass Atom=',GetAtom,' ',CurPos.StartPos>=ClassNode.EndPos]); repeat
if not ParseInnerClass(CurPos.StartPos) then //DebugLn(['TPascalParserTool.KeyWordFuncTypeClass Atom=',GetAtom,' ',CurPos.StartPos>=ClassNode.EndPos]);
begin if not ParseInnerBasicRecord(CurPos.StartPos) then
if CurPos.Flag<>cafEnd then begin
SaveRaiseStringExpectedButAtomFound(20170421195803,'end'); if CurPos.Flag<>cafEnd then
break; SaveRaiseStringExpectedButAtomFound(20190626160145,'end');
end; break;
ReadNextAtom; end;
until false; 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 // end last sub section
if CurNode.Desc in AllClassSubSections then begin if CurNode.Desc in AllClassSubSections then begin
CurNode.EndPos:=CurPos.StartPos; CurNode.EndPos:=CurPos.StartPos;

4
components/codetools/tests/runtestscodetools.lpi
View File

@ -1,14 +1,14 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="11"/> <Version Value="12"/>
<General> <General>
<Flags> <Flags>
<MainUnitHasCreateFormStatements Value="False"/> <MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/> <MainUnitHasTitleStatement Value="False"/>
<CompatibilityMode Value="True"/>
</Flags> </Flags>
<SessionStorage Value="InIDEConfig"/> <SessionStorage Value="InIDEConfig"/>
<MainUnit Value="0"/>
<Title Value="runtestscodetools"/> <Title Value="runtestscodetools"/>
<UseAppBundle Value="False"/> <UseAppBundle Value="False"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>

17
components/codetools/tests/testpascalparser.pas
View File

@ -44,6 +44,7 @@ type
published published
procedure TestAtomRing; procedure TestAtomRing;
procedure TestRecord_ClassOperators; procedure TestRecord_ClassOperators;
procedure TestRecord_Nonkeywords;
procedure TestDeprecated; procedure TestDeprecated;
procedure TestMissingGenericKeywordObjFPCFail; procedure TestMissingGenericKeywordObjFPCFail;
procedure TestParseGenericsDelphi; procedure TestParseGenericsDelphi;
@ -323,6 +324,7 @@ procedure TTestPascalParser.TestRecord_ClassOperators;
begin begin
StartProgram; StartProgram;
Add([ Add([
'{$modeswitch advancedrecords}',
'type', 'type',
' TFlag = (flag1);', ' TFlag = (flag1);',
'{$Define FPC_HAS_MANAGEMENT_OPERATORS}', '{$Define FPC_HAS_MANAGEMENT_OPERATORS}',
@ -376,6 +378,21 @@ begin
ParseModule; ParseModule;
end; 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; procedure TTestPascalParser.TestDeprecated;
begin begin
StartProgram; StartProgram;