Browse Source

* Fix bug #31194 : function alias not supported

git-svn-id: trunk@35346 -
michael 8 years ago
parent
commit
06a8b84426

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

@@ -837,6 +837,7 @@ type
     LibrarySymbolName,
     LibraryExpr : TPasExpr;
     DispIDExpr :  TPasExpr;
+    AliasName : String;
     Procedure AddModifier(AModifier : TProcedureModifier);
     Function IsVirtual : Boolean;
     Function IsDynamic : Boolean;

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

@@ -3513,6 +3513,14 @@ begin
       end
     else if DoCheckHint then
       ConsumeSemi
+    else if (CurToken=tkIdentifier) and (CompareText(CurTokenText,'alias')=0) then
+      begin
+      ExpectToken(tkColon);
+      ExpectToken(tkString);
+      if (Parent is TPasProcedure) then
+        (Parent as TPasProcedure).AliasName:=CurTokenText;
+      ExpectToken(tkSemicolon);
+      end
     else if (CurToken = tkSquaredBraceOpen) then
       begin
       repeat
@@ -3524,7 +3532,11 @@ begin
     if Done then
       begin
       NextToken;
-      Done:=Not ((Curtoken=tkSquaredBraceOpen) or TokenIsProcedureModifier(Parent,CurtokenString,Pm) or IscurtokenHint() or TokenisCallingConvention(CurTokenString,cc));
+      Done:=Not ((Curtoken=tkSquaredBraceOpen) or
+                  TokenIsProcedureModifier(Parent,CurtokenString,Pm) or
+                  IscurtokenHint() or
+                  TokenisCallingConvention(CurTokenString,cc) or
+                  (CurToken=tkIdentifier) and (CompareText(CurTokenText,'alias')=0));
 //      DumpCurToken('Done '+IntToStr(Ord(Done)));
       UngetToken;
       end;

+ 18 - 0
packages/fcl-passrc/tests/tcprocfunc.pas

@@ -152,6 +152,7 @@ type
     Procedure TestProcedureExternalName;
     Procedure TestFunctionExternalName;
     Procedure TestProcedureCdeclExternal;
+    Procedure TestProcedureAlias;
     Procedure TestFunctionCdeclExternal;
     Procedure TestProcedureCdeclExternalLibName;
     Procedure TestFunctionCdeclExternalLibName;
@@ -159,6 +160,7 @@ type
     Procedure TestFunctionCdeclExternalLibNameName;
     Procedure TestProcedureCdeclExternalName;
     Procedure TestFunctionCdeclExternalName;
+    Procedure TestFunctionAlias;
     Procedure TestOperatorTokens;
     procedure TestOperatorNames;
     Procedure TestFunctionNoResult;
@@ -1159,6 +1161,22 @@ begin
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
+procedure TTestProcedureFunction.TestFunctionAlias;
+begin
+  AddDeclaration('function A : Integer; alias: ''myalias''');
+  ParseFunction;
+  AssertFunc([],ccDefault,0);
+  AssertEquals('Alias name','''myalias''',Func.AliasName);
+end;
+
+procedure TTestProcedureFunction.TestProcedureAlias;
+begin
+  AddDeclaration('Procedure A; Alias : ''myalias''');
+  ParseProcedure;
+  AssertProc([],ccDefault,0);
+  AssertEquals('Alias name','''myalias''',Proc.AliasName);
+end;
+
 procedure TTestProcedureFunction.TestOperatorTokens;
 
 Var