From 57de41cad6c9f3856331df37f9a0143cb66016e7 Mon Sep 17 00:00:00 2001 From: mattias Date: Wed, 10 Jul 2019 08:01:16 +0000 Subject: [PATCH] fcl-passrc: fixed parsing class var a:t;b:t --- compiler/packages/fcl-passrc/src/pparser.pp | 56 +++++++++++++------ .../packages/fcl-passrc/tests/tcresolver.pas | 1 + compiler/packages/pastojs/tests/tcfiler.pas | 32 +++++++++++ compiler/packages/pastojs/tests/tcmodules.pas | 5 +- 4 files changed, 76 insertions(+), 18 deletions(-) diff --git a/compiler/packages/fcl-passrc/src/pparser.pp b/compiler/packages/fcl-passrc/src/pparser.pp index 478505b..2fe84df 100644 --- a/compiler/packages/fcl-passrc/src/pparser.pp +++ b/compiler/packages/fcl-passrc/src/pparser.pp @@ -6295,6 +6295,21 @@ end; // Starts on first token after Record or (. Ends on AEndToken procedure TPasParser.ParseRecordFieldList(ARec: TPasRecordType; AEndToken: TToken; AllowMethods: Boolean); +var + isClass : Boolean; + + procedure EnableIsClass; + begin + isClass:=True; + Scanner.SetTokenOption(toOperatorToken); + end; + + procedure DisableIsClass; + begin + if not isClass then exit; + isClass:=false; + Scanner.UnSetTokenOption(toOperatorToken); + end; Var VariantName : String; @@ -6302,21 +6317,24 @@ Var Proc: TPasProcedure; ProcType: TProcType; Prop : TPasProperty; - isClass : Boolean; NamePos: TPasSourcePos; OldCount, i: Integer; + LastToken: TToken; + CurEl: TPasElement; begin if AllowMethods then v:=visPublic else v:=visDefault; isClass:=False; + LastToken:=tkrecord; while CurToken<>AEndToken do begin SaveComments; Case CurToken of tkType: begin + DisableIsClass; if Not AllowMethods then ParseExc(nErrRecordTypesNotAllowed,SErrRecordTypesNotAllowed); ExpectToken(tkIdentifier); @@ -6324,6 +6342,7 @@ begin end; tkConst: begin + DisableIsClass; if Not AllowMethods then ParseExc(nErrRecordConstantsNotAllowed,SErrRecordConstantsNotAllowed); ExpectToken(tkIdentifier); @@ -6346,6 +6365,8 @@ begin end; tkClass: begin + if LastToken=tkclass then + ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError); if Not AllowMethods then begin NextToken; @@ -6356,18 +6377,16 @@ begin ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed); end; end; - if isClass then - ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError); - isClass:=True; - Scanner.SetTokenOption(toOperatorToken); + EnableIsClass; end; tkProperty: begin + DisableIsClass; if Not AllowMethods then ParseExc(nErrRecordPropertiesNotAllowed,SErrRecordPropertiesNotAllowed); ExpectToken(tkIdentifier); - Prop:=ParseProperty(ARec,CurtokenString,v,isClass); - Arec.Members.Add(Prop); + Prop:=ParseProperty(ARec,CurtokenString,v,LastToken=tkclass); + ARec.Members.Add(Prop); Engine.FinishScope(stDeclaration,Prop); end; tkOperator, @@ -6375,9 +6394,10 @@ begin tkConstructor, tkFunction : begin + DisableIsClass; if Not AllowMethods then ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed); - ProcType:=GetProcTypeFromToken(CurToken,isClass); + ProcType:=GetProcTypeFromToken(CurToken,LastToken=tkclass); Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,v); if Proc.Parent is TPasOverloadedProc then TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc) @@ -6399,10 +6419,17 @@ begin OldCount:=ARec.Members.Count; ParseInlineVarDecl(ARec, ARec.Members, v, AEndToken=tkBraceClose); for i:=OldCount to ARec.Members.Count-1 do - Engine.FinishScope(stDeclaration,TPasVariable(ARec.Members[i])); + begin + CurEl:=TPasElement(ARec.Members[i]); + if isClass then + With TPasVariable(CurEl) do + VarModifiers:=VarModifiers + [vmClass]; + Engine.FinishScope(stDeclaration,TPasVariable(CurEl)); + end; end; tkCase : begin + DisableIsClass; ARec.Variants:=TFPList.Create; NextToken; VariantName:=CurTokenString; @@ -6425,13 +6452,10 @@ begin else ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError); end; - If CurToken<>tkClass then - begin - isClass:=False; - Scanner.UnSetTokenOption(toOperatorToken); - end; - if CurToken<>AEndToken then - NextToken; + if CurToken=AEndToken then + break; + LastToken:=CurToken; + NextToken; end; end; diff --git a/compiler/packages/fcl-passrc/tests/tcresolver.pas b/compiler/packages/fcl-passrc/tests/tcresolver.pas index 72ec6c1..40cdf10 100644 --- a/compiler/packages/fcl-passrc/tests/tcresolver.pas +++ b/compiler/packages/fcl-passrc/tests/tcresolver.pas @@ -8170,6 +8170,7 @@ begin ' r.V1:=trec.VC;', ' r.VC:=r.V1;', ' trec.VC:=trec.c1;', + ' trec.ca[1]:=trec.c2;', '']); ParseProgram; end; diff --git a/compiler/packages/pastojs/tests/tcfiler.pas b/compiler/packages/pastojs/tests/tcfiler.pas index 13dca6e..06fdce7 100644 --- a/compiler/packages/pastojs/tests/tcfiler.pas +++ b/compiler/packages/pastojs/tests/tcfiler.pas @@ -160,6 +160,7 @@ type procedure TestPC_Class; procedure TestPC_ClassForward; procedure TestPC_ClassConstructor; + procedure TestPC_ClassDestructor; procedure TestPC_Initialization; procedure TestPC_BoolSwitches; procedure TestPC_ClassInterface; @@ -2134,6 +2135,37 @@ begin WriteReadUnit; end; +procedure TTestPrecompile.TestPC_ClassDestructor; +begin + StartUnit(false); + Add([ + 'interface', + 'type', + ' TObject = class', + ' destructor Destroy; virtual;', + ' end;', + ' TBird = class', + ' destructor Destroy; override;', + ' end;', + 'procedure DoIt;', + 'implementation', + 'destructor TObject.Destroy;', + 'begin', + 'end;', + 'destructor TBird.Destroy;', + 'begin', + ' inherited;', + 'end;', + 'procedure DoIt;', + 'var b: TBird;', + 'begin', + ' b.Destroy;', + 'end;', + 'end.' + ]); + WriteReadUnit; +end; + procedure TTestPrecompile.TestPC_Initialization; begin StartUnit(false); diff --git a/compiler/packages/pastojs/tests/tcmodules.pas b/compiler/packages/pastojs/tests/tcmodules.pas index 873f9c2..eaba319 100644 --- a/compiler/packages/pastojs/tests/tcmodules.pas +++ b/compiler/packages/pastojs/tests/tcmodules.pas @@ -10895,8 +10895,9 @@ begin '{$modeswitch AdvancedRecords}', 'type', ' TRec = record', - ' class var Fx: longint;', - ' class var Fy: longint;', + ' class var', + ' Fx: longint;', + ' Fy: longint;', ' class function GetInt: longint; static;', ' class procedure SetInt(Value: longint); static;', ' class procedure DoIt; static;',