Переглянути джерело

* Function result can also contain ^ in type

git-svn-id: trunk@47911 -
michael 4 роки тому
батько
коміт
46d301b7b2

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

@@ -5347,6 +5347,7 @@ Var
   OK: Boolean;
   IsProcType: Boolean; // false = procedure, true = procedure type
   IsAnonymous: Boolean;
+  OldForceCaret : Boolean;
   PTM: TProcTypeModifier;
   ModTokenCount: Integer;
   LastToken: TToken;
@@ -5364,7 +5365,12 @@ begin
       if CurToken = tkColon then
         begin
         ResultEl:=TPasFunctionType(Element).ResultEl;
-        ResultEl.ResultType := ParseType(ResultEl,CurSourcePos);
+        OldForceCaret:=Scanner.SetForceCaret(True);
+        try
+          ResultEl.ResultType := ParseType(ResultEl,CurSourcePos);
+        finally
+          Scanner.SetForceCaret(OldForceCaret);
+        end;
         end
       // In Delphi mode, the signature in the implementation section can be
       // without result as it was declared

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

@@ -103,6 +103,7 @@ type
     procedure TestProcedureConstArrayOfConstArg;
     Procedure TestFunctionConstArrayOfConstArg;
     procedure TestProcedureOnePointerArg;
+    procedure TestFUnctionPointerResult;
 
     Procedure TestProcedureCdecl;
     Procedure TestFunctionCdecl;
@@ -245,6 +246,7 @@ end;
 function TTestProcedureFunction.ParseFunction(const ASource : String;AResult: string = ''; const AHint: String = ''; CC : TCallingConvention = ccDefault): TPasProcedure;
 Var
   D :String;
+  aType : TPasType;
 begin
   if (AResult='') then
     AResult:='Integer';
@@ -255,8 +257,16 @@ begin
   Self.ParseFunction;
   Result:=FFunc;
   AssertNotNull('Have function result element',FuncType.ResultEl);
-  AssertNotNull('Have function result type element',FuncType.ResultEl.ResultType);
-  AssertEquals('Correct function result type name',AResult,FuncType.ResultEl.ResultType.Name);
+  aType:=FuncType.ResultEl.ResultType;
+  AssertNotNull('Have function result type element',aType);
+  if aResult[1]='^' then
+    begin
+    Delete(aResult,1,1);
+    AssertEquals('Result is pointer type',TPasPointerType,aType.ClassType);
+    aType:=TPasPointerType(aType).DestType;
+    AssertNotNull('Result pointer type has destination type',aType);
+    end;
+  AssertEquals('Correct function result type name',AResult,aType.Name);
 end;
 
 procedure TTestProcedureFunction.ParseOperator;
@@ -501,6 +511,12 @@ begin
   AssertArg(ProcType,0,'B',argDefault,'^Integer','');
 end;
 
+procedure TTestProcedureFunction.TestFunctionPointerResult;
+begin
+  ParseFunction('()','^LongInt');
+  AssertFunc([],[],ccDefault,0);
+end;
+
 procedure TTestProcedureFunction.TestFunctionOneArg;
 begin
   ParseFunction('(B : Integer)');