diff --git a/packages/fcl-passrc/src/pastree.pp b/packages/fcl-passrc/src/pastree.pp index c277a80871..1076393c0b 100644 --- a/packages/fcl-passrc/src/pastree.pp +++ b/packages/fcl-passrc/src/pastree.pp @@ -1554,6 +1554,18 @@ type Body: TPasImplElement; end; + { TPasInlineVarDeclStatement } + + TPasInlineVarDeclStatement = class(TPasImplStatement) + public + Declarations: TFPList; // list of TPasVariable + Public + constructor Create(const aName : TPasTreeString; aParent: TPasElement); override; + procedure FreeChildren(Prepare: boolean); override; + destructor Destroy; override; + end; + + TPasImplCaseStatement = class; TPasImplCaseElse = class; @@ -1610,6 +1622,8 @@ type StartExpr : TPasExpr; EndExpr : TPasExpr; // if LoopType=ltIn this is nil Variable: TPasVariable; // not used by TPasParser + VarType : TPasType; // For initialized variables + ImplicitTyped : Boolean; Body: TPasImplElement; Function Down: boolean; inline;// downto, backward compatibility Function StartValue : TPasTreeString; @@ -3950,6 +3964,7 @@ begin StartExpr:=TPasExpr(FreeChild(StartExpr,Prepare)); EndExpr:=TPasExpr(FreeChild(EndExpr,Prepare)); Variable:=TPasVariable(FreeChild(Variable,Prepare)); + VarType:=TPasType(FreeChild(VarType,Prepare)); Body:=TPasImplElement(FreeChild(Body,Prepare)); inherited FreeChildren(Prepare); end; @@ -5450,6 +5465,26 @@ begin inherited ForEachCall(aMethodCall, Arg); end; +{ TPasInlineVarDeclStatement } + +constructor TPasInlineVarDeclStatement.Create(const aName: TPasTreeString; aParent: TPasElement); +begin + inherited Create('',aParent); + Declarations:=TFPList.Create; +end; + +procedure TPasInlineVarDeclStatement.FreeChildren(Prepare: boolean); +begin + FreeChildList(Declarations,Prepare); + inherited FreeChildren(Prepare); +end; + +destructor TPasInlineVarDeclStatement.Destroy; +begin + inherited Destroy; + FreeAndNil(Declarations) +end; + { TPasImplTry } procedure TPasImplTry.FreeChildren(Prepare: boolean); diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index b0899dce5a..f1071aac28 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -294,6 +294,7 @@ type private const FTokenRingSize = 32; type + TDeclParseType = (dptBasic,dptFull,dptInline); { TTokenRec } @@ -336,6 +337,7 @@ type procedure ParseRaise; procedure ParseWhile; procedure ParseWith; + procedure ParseVarStatement; end; //PParseStatementParams = ^TParseStatementParams; private @@ -377,12 +379,12 @@ type function GetVariableModifiers(Parent: TPasElement; Out VarMods: TVariableModifiers; Out LibName, ExportName: TPasExpr; const AllowedMods: TVariableModifiers): string; - function GetVariableValueAndLocation(Parent : TPasElement; Out Value: TPasExpr; Out AbsoluteExpr: TPasExpr; Out Location: String): Boolean; + function GetVariableValueAndLocation(Parent : TPasElement; IsUntypedInline : Boolean; Out Value: TPasExpr; Out AbsoluteExpr: TPasExpr; Out Location: String): Boolean; procedure HandleProcedureModifier(Parent: TPasElement; pm : TProcedureModifier; IsBracketed : Boolean = false); procedure HandleProcedureTypeModifier(ProcType: TPasProcedureType; ptm : TProcTypeModifier); procedure ParseMembersLocalConsts(AType: TPasMembersType; AVisibility: TPasMemberVisibility); procedure ParseMembersLocalTypes(AType: TPasMembersType; AVisibility: TPasMemberVisibility); - procedure ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; Full: Boolean); + procedure ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; varParseType : TDeclParseType); procedure SetOptions(AValue: TPOptions); procedure OnScannerModeChanged(Sender: TObject; NewMode: TModeSwitch; Before: boolean; var Handled: boolean); @@ -509,6 +511,7 @@ type function ParseTypeDecl(Parent: TPasElement): TPasType; overload; function ParseTypeDecl(Parent: TPasElement; NamePos : TPasSourcePos): TPasType; overload; function ParseGenericTypeDecl(Parent: TPasElement; AddToParent: boolean): TPasGenericType; + function ParseType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String; DeclParseType: TDeclParseType): TPasType; function ParseType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String = ''; Full: Boolean = false): TPasType; function ParseReferenceToProcedureType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasProcedureType; function ParseProcedureType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; const PT: TProcType): TPasProcedureType; @@ -2124,6 +2127,16 @@ function TPasParser.ParseType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String; Full: Boolean ): TPasType; +Const + TS : Array[boolean] of TDeclParseType = (dptBasic,dptFull); + +begin + Result:=ParseType(Parent,NamePos,TypeName,TS[Full]); +end; + +function TPasParser.ParseType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String; + DeclParseType: TDeclParseType): TPasType; + Type TLocalClassType = (lctClass,lctObjcClass,lctObjcCategory,lctHelper); @@ -2145,7 +2158,7 @@ begin Result := nil; // NextToken and check pack mode Pm:=CheckPackMode; - if Full then + if DeclParseType=dptFull then CH:=Not (CurToken in NoHintTokens) else begin @@ -2178,7 +2191,7 @@ begin begin lClassType:=lctClass; NextToken; - if not (Full or (CurToken=tkOf)) then + if not ((DeclParseType=dptFull) or (CurToken=tkOf)) then ParseExc(nParserTypeNotAllowedHere,SParserTypeNotAllowedHere,[CurtokenText]); // Parser.CurrentModeswitches:=Parser.CurrentModeswitches+[msClass]; @@ -2227,7 +2240,7 @@ begin Result:=ParseReferencetoProcedureType(Parent,NamePos,TypeName) end else - Result:=ParseSimpleType(Parent,NamePos,TypeName,Full); + Result:=ParseSimpleType(Parent,NamePos,TypeName,declParseType=dptFull); end; tkCaret: Result:=ParsePointerType(Parent,NamePos,TypeName); tkFile: Result:=ParseFileType(Parent,NamePos,TypeName); @@ -2257,7 +2270,7 @@ begin tkNumber,tkMinus,tkChar: begin UngetToken; - Result:=ParseRangeType(Parent,NamePos,TypeName,Full); + Result:=ParseRangeType(Parent,NamePos,TypeName,declParseType=dptFull); end; else ParseExcExpectedIdentifier; @@ -4729,19 +4742,27 @@ begin end; end; -function TPasParser.GetVariableValueAndLocation(Parent: TPasElement; out - Value: TPasExpr; out AbsoluteExpr: TPasExpr; out Location: String): Boolean; + +function TPasParser.GetVariableValueAndLocation(Parent: TPasElement; IsUntypedInline: Boolean; out Value: TPasExpr; out + AbsoluteExpr: TPasExpr; out Location: String): Boolean; begin Value:=Nil; AbsoluteExpr:=Nil; Location:=''; NextToken; - Result:=CurToken=tkEqual; + if IsUntypedInline then + Result:=CurToken=tkAssign + else + Result:=CurToken=tkEqual; if Result then begin NextToken; - Value := DoParseConstValueExpression(Parent); + if IsUntypedInline then + Value := DoParseExpression(Parent) + else + Value := DoParseConstValueExpression(Parent); + end; if (CurToken=tkAbsolute) then begin @@ -4834,8 +4855,8 @@ end; // Full means that a full variable declaration is being parsed. -procedure TPasParser.ParseVarList(Parent: TPasElement; VarList: TFPList; - AVisibility: TPasMemberVisibility; Full : Boolean); +procedure TPasParser.ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; + varParseType: TDeclParseType); // on Exception the VarList is restored, no need to Release the new elements var @@ -4847,6 +4868,7 @@ var VarMods, AllowedVarMods: TVariableModifiers; D,Mods,AbsoluteLocString: string; OldForceCaret,ok,ExternalStruct: Boolean; + IsUntyped : Boolean; begin Value:=Nil; @@ -4856,6 +4878,7 @@ begin AbsoluteLocString:=''; VarCnt:=0; ok:=false; + IsUntyped:=False; try D:=SaveComments; // This means we support only one comment per 'list'. VarEl:=nil; @@ -4878,29 +4901,39 @@ begin case CurToken of tkColon: break; tkComma: ExpectIdentifier; + tkAssign : + begin + if varParseType<>dptInline then + ParseExc(nParserExpectedCommaColon,SParserExpectedCommaColon); + UnGetToken; // Value parsing starts with NextToken + IsUnTyped:=True; + break; + end; else ParseExc(nParserExpectedCommaColon,SParserExpectedCommaColon); end; Until (CurToken=tkColon); - OldForceCaret:=Scanner.SetForceCaret(True); - try - VarType := ParseVarType(VarEl); // Note: this can insert elements into VarList! - {$IFDEF CheckPasTreeRefCount}if VarType.RefIds.IndexOf('CreateElement')>=0 then VarType.ChangeRefId('CreateElement','TPasVariable.VarType'){$ENDIF}; - finally - Scanner.SetForceCaret(OldForceCaret); - end; - // read type - for i := VarList.Count-VarCnt to VarList.Count - 1 do + if CurToken=tkColon then begin - VarEl:=TPasVariable(VarList[i]); - // Writeln(VarEl.Name, AVisibility); - VarEl.VarType := VarType; - //VarType.Parent := VarEl; // this is wrong for references + OldForceCaret:=Scanner.SetForceCaret(True); + try + VarType := ParseVarType(VarEl); // Note: this can insert elements into VarList! + {$IFDEF CheckPasTreeRefCount}if VarType.RefIds.IndexOf('CreateElement')>=0 then VarType.ChangeRefId('CreateElement','TPasVariable.VarType'){$ENDIF}; + finally + Scanner.SetForceCaret(OldForceCaret); + end; + // read type + for i := VarList.Count-VarCnt to VarList.Count - 1 do + begin + VarEl:=TPasVariable(VarList[i]); + // Writeln(VarEl.Name, AVisibility); + VarEl.VarType := VarType; + //VarType.Parent := VarEl; // this is wrong for references + end; end; - H:=CheckHint(Nil,False); - If Full then - GetVariableValueAndLocation(VarEl,Value,AbsoluteExpr,AbsoluteLocString); + If varParseType in [dptFull,dptInline]then + GetVariableValueAndLocation(VarEl,IsUnTyped,Value,AbsoluteExpr,AbsoluteLocString); if VarCnt>1 then begin // multiple variables @@ -4917,7 +4950,7 @@ begin and (Parent is TPasMembersType); H:=H+CheckHint(Nil,False); - if Full or ExternalStruct then + if (VarParseType=dptFull) or ExternalStruct then begin NextToken; If Curtoken<>tkSemicolon then @@ -5058,7 +5091,7 @@ begin if ClosingBrace then Include(tt,tkBraceClose); try - ParseVarList(Parent,List,AVisibility,False); + ParseVarList(Parent,List,AVisibility,dptBasic); except on E : Exception do if not TryErrorRecovery(CreateRecovery(E,tt,False)) then @@ -5073,7 +5106,7 @@ procedure TPasParser.ParseVarDecl(Parent: TPasElement; List: TFPList); begin try - ParseVarList(Parent,List,visDefault,True); + ParseVarList(Parent,List,visDefault,dptFull); except on E : Exception do if not TryErrorRecovery(CreateRecovery(E,[tkSemicolon],False)) then @@ -6387,6 +6420,16 @@ begin break; tkEOF: CheckToken(tkend); + tkVar: + begin + if not (msInlineVars in CurrentModeswitches) then + ParseExcSyntaxError; + CheckStatementCanStart; + NextToken; + Params.ParseVarStatement; + Params.CloseStatement(true); + + end; tkAt,tkAtAt, tkIdentifier,tkspecialize, tkNumber,tkString,tkfalse,tktrue,tkChar, @@ -8114,14 +8157,27 @@ end; procedure TPasParser.TParseStatementParams.ParseFor; // for VarName := StartValue to EndValue do +// for var VarName := StartValue to EndValue do +// for var VarName : Integer := StartValue to EndValue do + // for VarName in Expression do var ForLoop: TPasImplForLoop; Expr: TPasExpr; lt: TLoopType; SrcPos: TPasSourcePos; + isVarDef : Boolean; begin ForLoop:=TPasImplForLoop(CreateElement(TPasImplForLoop)); + isVarDef:=False; + if (msInlineVars in Parser.CurrentModeswitches) then + begin + Parser.NextToken; + isVarDef:=Parser.CurToken=tkvar; + if not IsVarDef then + Parser.UngetToken; + end; + SrcPos:=Parser.CurTokenPos; Parser.ExpectIdentifier; Expr:=Parser.CreatePrimitiveExpr(ForLoop,pekIdent,Parser.CurTokenString); ForLoop.VariableName:=Expr; @@ -8131,15 +8187,26 @@ begin tkAssign: begin lt:=ltNormal; + ForLoop.ImplicitTyped:=IsVarDef and (ForLoop.VarType=Nil); break; end; + tkColon: + begin + if not IsVarDef then + Parser.ParseExc(nParserExpectedAssignIn,SParserExpectedAssignIn); + ForLoop.VarType:=Parser.ParseType(ForLoop,SrcPos); + // We should be on identifier + end; tkin: begin lt:=ltIn; + ForLoop.ImplicitTyped:=IsVarDef and (ForLoop.VarType=Nil); break; end; tkDot: begin + if IsVarDef then + Parser.ParseExc(nParserExpectedAssignIn,SParserExpectedAssignIn); SrcPos:=Parser.CurTokenPos; Parser.ExpectIdentifier; Parser.AddToBinaryExprChain(Expr, @@ -8276,6 +8343,41 @@ begin until false; end; +procedure TPasParser.TParseStatementParams.ParseVarStatement; + +var + List : TFPList; + VarSt : TPasInlineVarDeclStatement; + SrcPos: TPasSourcePos; + I : Integer; + V : TPasVariable; + +begin + // var a : Integer; + // var a : Integer = Expr; + // var a := Expr; + SrcPos:=Parser.CurTokenPos; + VarSt:=TPasInlineVarDeclStatement(CreateElement(TPasInlineVarDeclStatement,SrcPos)); + NewImplElement:=VarSt; + CurBlock.AddElement(VarSt); + List := TFPList.Create; + try + Parser.ParseVarList(VarSt,List,visDefault,dptInline); + For I:=0 to List.Count-1 do + begin + V:=TPasVariable(List[i]); + List[i]:=Nil; + VarSt.Declarations.Add(V); + end; + finally + For I:=0 to List.count-1 do + if List[i]<>Nil then + TObject(List[I]).Free; + List.Free; + end; + +end; + function TPasParser.TParseStatementParams.ParseOn: boolean; // in try except: // on E: Exception do diff --git a/packages/fcl-passrc/src/pscanner.pp b/packages/fcl-passrc/src/pscanner.pp index 490406ec10..d49c9f965e 100644 --- a/packages/fcl-passrc/src/pscanner.pp +++ b/packages/fcl-passrc/src/pscanner.pp @@ -341,7 +341,8 @@ type msExternalClass, { pas2js: Allow external class definitions } msOmitRTTI, { pas2js: treat class section 'published' as 'public' and typeinfo does not work on symbols declared with this switch } msMultiLineStrings, { pas2js: Multiline strings } - msDelphiMultiLineStrings { Delpi-compatible multiline strings } + msDelphiMultiLineStrings, { Delpi-compatible multiline strings } + msInlineVars { Allow inline var declarations } ); TModeSwitches = Set of TModeSwitch; @@ -1184,7 +1185,8 @@ const 'EXTERNALCLASS', 'OMITRTTI', 'MULTILINESTRINGS', - 'DELPHIMULTILINESTRINGS' + 'DELPHIMULTILINESTRINGS', + 'INLINEVARS' ); LetterSwitchNames: array['A'..'Z'] of TPasScannerString=( @@ -1272,7 +1274,8 @@ const msOut,msDefaultPara,msDuplicateNames,msHintDirective, msProperty,msDefaultInline,msExcept,msAdvancedRecords,msTypeHelpers, msPrefixedAttributes,msArrayOperators,msImplicitFunctionSpec, - msFunctionReferences,msAnonymousFunctions,msDelphiMultiLineStrings + msFunctionReferences,msAnonymousFunctions,msDelphiMultiLineStrings, + msInlineVars ]; DelphiUnicodeModeSwitches = delphimodeswitches + [msSystemCodePage,msDefaultUnicodestring]; @@ -5359,6 +5362,7 @@ var OldLength: integer; Ch: AnsiChar; LE: String[2]; + I : Integer; {$else} TokenStart: Integer; s: String; @@ -5393,14 +5397,14 @@ begin begin SectionLength:=FTokenPos - TokenStart; {$ifdef UsePChar} - SetLength(FCurTokenString, OldLength + SectionLength + length(LineEnding)); // Corrected JC + SetLength(FCurTokenString, OldLength + SectionLength + length(LE)); // Corrected JC if SectionLength > 0 then Move(TokenStart^, FCurTokenString[OldLength + 1],SectionLength); Inc(OldLength, SectionLength); - for Ch in LE do + for I:=1 to Length(LE) do begin Inc(OldLength); - FCurTokenString[OldLength] := Ch; + FCurTokenString[OldLength] := LE[i]; end; {$else} FCurTokenString:=FCurTokenString+copy(FCurLine,TokenStart,SectionLength)+LineEnding; // Corrected JC @@ -5455,6 +5459,7 @@ var TokenStart: PAnsiChar; OldLength: integer; Ch: AnsiChar; + I : Integer; LE: String[2]; {$else} TokenStart: Integer; @@ -5487,16 +5492,16 @@ begin begin SectionLength := FTokenPos - TokenStart; {$ifdef UsePChar} - SetLength(FCurTokenString, OldLength + SectionLength + length(LineEnding)); // Corrected JC + SetLength(FCurTokenString, OldLength + SectionLength + length(LE)); // Corrected JC if SectionLength > 0 then Move(TokenStart^, FCurTokenString[OldLength + 1],SectionLength); // Corrected JC: Append the correct lineending Inc(OldLength, SectionLength); - for Ch in LE do + for I:=1 to length(LE) do begin Inc(OldLength); - FCurTokenString[OldLength] := Ch; + FCurTokenString[OldLength] := LE[i]; end; {$else} FCurTokenString:=FCurTokenString+copy(FCurLine,TokenStart,SectionLength)+LineEnding; // Corrected JC diff --git a/packages/fcl-passrc/tests/tcstatements.pas b/packages/fcl-passrc/tests/tcstatements.pas index 23bb17d897..b541c6d798 100644 --- a/packages/fcl-passrc/tests/tcstatements.pas +++ b/packages/fcl-passrc/tests/tcstatements.pas @@ -82,7 +82,11 @@ Type procedure TestRepeatBlockNosemicolon; Procedure TestRepeatNested; Procedure TestFor; + Procedure TestForVarDef; + Procedure TestForVarDefImplicit; Procedure TestForIn; + Procedure TestForInDef; + Procedure TestForInDefImplicit; Procedure TestForExpr; Procedure TestForBlock; procedure TestDowntoBlock; @@ -133,6 +137,9 @@ Type Procedure TestPlatformIdentifier; Procedure TestPlatformIdentifier2; Procedure TestArgumentNameOn; + Procedure TestInlineVarDeclaration; + Procedure TestInlineVarDeclarationDotted; + Procedure TestInlineVarDeclarationNoType; end; @@ -909,6 +916,44 @@ begin AssertNull('Empty body',F.Body); end; +procedure TTestStatementParser.TestForVarDef; +Var + F : TPasImplForLoop; +begin + AddStatements([ + '{$modeswitch inlinevars}', + 'for var a : integer := 1 to 10 do',';' + ]); + ParseModule; + F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop; + AssertExpression('Loop variable name',F.VariableName,pekIdent,'a'); + AssertEquals('Loop type',ltNormal,F.Looptype); + AssertEquals('Implicitly typed',False,F.ImplicitTyped); + AssertNotNull('Var type',F.VarType); + AssertExpression('Start value',F.StartExpr,pekNumber,'1'); + AssertExpression('end value',F.EndExpr,pekNumber,'10'); + AssertNull('Empty body',F.Body); +end; + +procedure TTestStatementParser.TestForVarDefImplicit; +Var + F : TPasImplForLoop; +begin + AddStatements([ + '{$modeswitch inlinevars}', + 'for var a := 1 to 10 do',';' + ]); + ParseModule; + F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop; + AssertExpression('Loop variable name',F.VariableName,pekIdent,'a'); + AssertEquals('Loop type',ltNormal,F.Looptype); + AssertEquals('Implicitly typed',True,F.ImplicitTyped); + AssertNull('Var type',F.VarType); + AssertExpression('Start value',F.StartExpr,pekNumber,'1'); + AssertExpression('end value',F.EndExpr,pekNumber,'10'); + AssertNull('Empty body',F.Body); +end; + procedure TTestStatementParser.TestForIn; Var @@ -926,6 +971,45 @@ begin AssertNull('Empty body',F.Body); end; +procedure TTestStatementParser.TestForInDef; +Var + F : TPasImplForLoop; + +begin + TestStatement(['{$modeswitch inlinevars}', + 'For var a : Integer in SomeSet Do', + ';']); + F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop; + AssertExpression('Loop variable name',F.VariableName,pekIdent,'a'); + AssertEquals('Loop type',ltIn,F.Looptype); + AssertEquals('Implicitly typed',False,F.ImplicitTyped); + AssertNotNull('Var type',F.VarType); + AssertEquals('In loop',False,F.Down); + AssertExpression('Start value',F.StartExpr,pekIdent,'SomeSet'); + AssertNull('Loop type',F.EndExpr); + AssertNull('Empty body',F.Body); + +end; + +procedure TTestStatementParser.TestForInDefImplicit; +Var + F : TPasImplForLoop; + +begin + TestStatement(['{$modeswitch inlinevars}', + 'For var a in SomeSet Do', + ';']); + F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop; + AssertExpression('Loop variable name',F.VariableName,pekIdent,'a'); + AssertEquals('Loop type',ltIn,F.Looptype); + AssertEquals('Implicitly typed',True,F.ImplicitTyped); + AssertNull('Var type',F.VarType); + AssertEquals('In loop',False,F.Down); + AssertExpression('Start value',F.StartExpr,pekIdent,'SomeSet'); + AssertNull('Loop type',F.EndExpr); + AssertNull('Empty body',F.Body); +end; + procedure TTestStatementParser.TestForExpr; Var F : TPasImplForLoop; @@ -1984,6 +2068,36 @@ begin ParseModule; end; +procedure TTestStatementParser.TestInlineVarDeclaration; +begin + AddStatements([ + '{$modeswitch inlinevars}', + 'var a : integer;' + ]); + ParseModule; + AssertStatement('Var declaration statement',TPasInlineVarDeclStatement); +end; + +procedure TTestStatementParser.TestInlineVarDeclarationDotted; +begin + AddStatements([ + '{$modeswitch inlinevars}', + 'var a := c.d(x);' + ]); + ParseModule; + AssertStatement('Var declaration statement',TPasInlineVarDeclStatement); +end; + +procedure TTestStatementParser.TestInlineVarDeclarationNoType; +begin + AddStatements([ + '{$modeswitch inlinevars}', + 'var a := 1;' + ]); + ParseModule; + AssertStatement('Var declaration statement',TPasInlineVarDeclStatement); +end; + procedure TTestStatementParser.TestGotoInIfThen; begin