Browse Source

* Absolute is allowed as variable/type/const name

git-svn-id: trunk@47497 -
michael 4 years ago
parent
commit
f8eac112d1

+ 1 - 0
packages/fcl-passrc/src/pparser.pp

@@ -3616,6 +3616,7 @@ begin
       pt:=GetProcTypeFromToken(CurToken,True);
       AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt, MustBeGeneric));
       end;
+    tkAbsolute,
     tkIdentifier:
       begin
       Scanner.UnSetTokenOption(toOperatorToken);

+ 14 - 0
packages/fcl-passrc/tests/tconstparser.pas

@@ -43,6 +43,7 @@ Type
     Procedure TestSimpleIdentifierConst;
     Procedure TestSimpleSetConst;
     Procedure TestSimpleExprConst;
+    Procedure TestSimpleAbsoluteConst;
     Procedure TestSimpleIntConstDeprecatedMsg;
     Procedure TestSimpleIntConstDeprecated;
     Procedure TestSimpleFloatConstDeprecated;
@@ -255,6 +256,19 @@ begin
   DoTestSimpleExprConst;
 end;
 
+procedure TTestConstParser.TestSimpleAbsoluteConst;
+
+// Found in xi.pp
+
+begin
+  Add('Const');
+  Add('  Absolute = 1;');
+  ParseDeclarations;
+  AssertEquals('One constant definition',1,Declarations.Consts.Count);
+  AssertEquals('First declaration is constant definition.',TPasConst,TObject(Declarations.Consts[0]).ClassType);
+
+end;
+
 procedure TTestConstParser.TestSimpleIntConstDeprecatedMsg;
 begin
   Hint:='deprecated ''this is old''' ;

+ 11 - 0
packages/fcl-passrc/tests/tctypeparser.pas

@@ -50,6 +50,7 @@ type
     Procedure DoTestClassOf(Const AHint : string);
   Published
     Procedure TestAliasType;
+    procedure TestAbsoluteAliasType;
     Procedure TestCrossUnitAliasType;
     Procedure TestAliasTypeDeprecated;
     Procedure TestAliasTypePlatform;
@@ -2894,11 +2895,21 @@ begin
 end;
 
 procedure TTestTypeParser.TestAliasType;
+
 begin
   DoTestAliasType('othertype','');
   AssertEquals('Unresolved type name ','othertype',TPasUnresolvedTypeRef(TPasAliasType(TheType).DestType).name);
 end;
 
+procedure TTestTypeParser.TestAbsoluteAliasType;
+begin
+  Add('Type');
+  Add('  Absolute = Integer;');
+  ParseDeclarations;
+  AssertEquals('First declaration is type definition.',TPasAliasType,TPasElement(Declarations.Types[0]).ClassType);
+  AssertEquals('First declaration has correct name.','Absolute',TPasElement(Declarations.Types[0]).Name);
+end;
+
 procedure TTestTypeParser.TestCrossUnitAliasType;
 begin
   DoTestAliasType('otherunit.othertype','');

+ 16 - 0
packages/fcl-passrc/tests/tcvarparser.pas

@@ -26,6 +26,7 @@ Type
     Procedure TearDown; override;
   Published
     Procedure TestSimpleVar;
+    Procedure TestSimpleVarAbsoluteName;
     Procedure TestSimpleVarHelperName;
     procedure TestSimpleVarHelperType;
     Procedure TestSimpleVarDeprecated;
@@ -129,6 +130,21 @@ begin
   AssertVariableType('b');
 end;
 
+procedure TTestVarParser.TestSimpleVarAbsoluteName;
+Var
+  R : TPasVariable;
+
+begin
+  Add('Var');
+  Add('  Absolute : integer;');
+//  Writeln(source.text);
+  ParseDeclarations;
+  AssertEquals('One variable definition',1,Declarations.Variables.Count);
+  AssertEquals('First declaration is type definition.',TPasVariable,TObject(Declarations.Variables[0]).ClassType);
+  R:=TPasVariable(Declarations.Variables[0]);
+  AssertEquals('First declaration has correct name.','Absolute',R.Name);
+end;
+
 procedure TTestVarParser.TestSimpleVarHelperName;
 
 Var