Browse Source

* Added support for C-style assignments

git-svn-id: trunk@22135 -
michael 13 years ago
parent
commit
c087aff3b2

+ 1 - 1
packages/fcl-passrc/src/pastree.pp

@@ -492,7 +492,7 @@ type
     Members: TFPList;     // array of TPasVariable elements
     VariantName: string;
     VariantType: TPasType;
-    Variants: TFPList;	// array of TPasVariant elements, may be nil!
+    Variants: TFPList;  // array of TPasVariant elements, may be nil!
     Function IsPacked: Boolean;
     Function IsBitPacked : Boolean;
   end;

+ 8 - 0
packages/fcl-passrc/tests/tcbaseparser.pas

@@ -68,6 +68,7 @@ Type
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TPasMemberVisibility); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureModifier); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureModifiers); overload;
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TAssignKind); overload;
     Procedure HaveHint(AHint : TPasMemberHint; AHints : TPasMemberHints);
     Property Resolver : TStreamResolver Read FResolver;
     Property Scanner : TPascalScanner Read FScanner;
@@ -430,6 +431,13 @@ begin
   AssertEquals(Msg,Sn(AExpected),SN(AActual));
 end;
 
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TAssignKind);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TAssignKind),Ord(AExpected)),
+                   GetEnumName(TypeInfo(TAssignKind),Ord(AActual)));
+end;
+
 procedure TTestParser.HaveHint(AHint: TPasMemberHint; AHints: TPasMemberHints);
 begin
   If not (AHint in AHints) then

+ 32 - 0
packages/fcl-passrc/tests/tcscanner.pas

@@ -99,6 +99,10 @@ type
     procedure TestBackslash;
     procedure TestDotDot;
     procedure TestAssign;
+    procedure TestAssignPlus;
+    procedure TestAssignMinus;
+    procedure TestAssignMul;
+    procedure TestAssignDivision;
     procedure TestNotEqual;
     procedure TestLessEqualThan;
     procedure TestGreaterEqualThan;
@@ -636,6 +640,34 @@ begin
   TestToken(tkAssign,':=');
 end;
 
+procedure TTestScanner.TestAssignPlus;
+begin
+  TestTokens([tkPlus,tkEqual],'+=');
+  FScanner.Options:=[po_cassignments];
+  TestToken(tkAssignPlus,'+=');
+end;
+
+procedure TTestScanner.TestAssignMinus;
+begin
+  TestTokens([tkMinus,tkEqual],'-=');
+  FScanner.Options:=[po_cassignments];
+  TestToken(tkAssignMinus,'-=');
+end;
+
+procedure TTestScanner.TestAssignMul;
+begin
+  TestTokens([tkMul,tkEqual],'*=');
+  FScanner.Options:=[po_cassignments];
+  TestToken(tkAssignMul,'*=');
+end;
+
+procedure TTestScanner.TestAssignDivision;
+begin
+  TestTokens([tkDivision,tkEqual],'*=');
+  FScanner.Options:=[po_cassignments];
+  TestToken(tkAssignDivision,'/=');
+end;
+
 
 procedure TTestScanner.TestNotEqual;
 

+ 70 - 0
packages/fcl-passrc/tests/tcstatements.pas

@@ -32,6 +32,10 @@ Type
     Procedure TestEmptyStatements;
     Procedure TestBlock;
     Procedure TestAssignment;
+    Procedure TestAssignmentAdd;
+    Procedure TestAssignmentMinus;
+    Procedure TestAssignmentMul;
+    Procedure TestAssignmentDivision;
     Procedure TestCall;
     Procedure TestCallQualified;
     Procedure TestCallQualified2;
@@ -213,6 +217,72 @@ begin
   AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
   AssertEquals('Assignment statement',TPasImplAssign,Statement.ClassType);
   A:=Statement as TPasImplAssign;
+  AssertEquals('Normal assignment',akDefault,A.Kind);
+  AssertExpression('Right side is constant',A.Right,pekNumber,'1');
+  AssertExpression('Left side is variable',A.Left,pekIdent,'a');
+end;
+
+procedure TTestStatementParser.TestAssignmentAdd;
+
+Var
+  A : TPasImplAssign;
+
+begin
+  Parser.Scanner.Options:=[po_cassignments];
+  DeclareVar('integer');
+  TestStatement(['a+=1;']);
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertEquals('Assignment statement',TPasImplAssign,Statement.ClassType);
+  A:=Statement as TPasImplAssign;
+  AssertEquals('Add assignment',akAdd,A.Kind);
+  AssertExpression('Right side is constant',A.Right,pekNumber,'1');
+  AssertExpression('Left side is variable',A.Left,pekIdent,'a');
+end;
+
+procedure TTestStatementParser.TestAssignmentMinus;
+Var
+  A : TPasImplAssign;
+
+begin
+  Parser.Scanner.Options:=[po_cassignments];
+  DeclareVar('integer');
+  TestStatement(['a-=1;']);
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertEquals('Assignment statement',TPasImplAssign,Statement.ClassType);
+  A:=Statement as TPasImplAssign;
+  AssertEquals('Minus assignment',akMinus,A.Kind);
+  AssertExpression('Right side is constant',A.Right,pekNumber,'1');
+  AssertExpression('Left side is variable',A.Left,pekIdent,'a');
+end;
+
+procedure TTestStatementParser.TestAssignmentMul;
+Var
+  A : TPasImplAssign;
+
+begin
+  Parser.Scanner.Options:=[po_cassignments];
+  DeclareVar('integer');
+  TestStatement(['a*=1;']);
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertEquals('Assignment statement',TPasImplAssign,Statement.ClassType);
+  A:=Statement as TPasImplAssign;
+  AssertEquals('Mul assignment',akMul,A.Kind);
+  AssertExpression('Right side is constant',A.Right,pekNumber,'1');
+  AssertExpression('Left side is variable',A.Left,pekIdent,'a');
+end;
+
+procedure TTestStatementParser.TestAssignmentDivision;
+Var
+  A : TPasImplAssign;
+
+begin
+  Parser.Scanner.Options:=[po_cassignments];
+  DeclareVar('integer');
+  TestStatement(['a/=1;']);
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertEquals('Assignment statement',TPasImplAssign,Statement.ClassType);
+  A:=Statement as TPasImplAssign;
+  AssertEquals('Division assignment',akDivision,A.Kind);
   AssertExpression('Right side is constant',A.Right,pekNumber,'1');
   AssertExpression('Left side is variable',A.Left,pekIdent,'a');
 end;