* Fix Pointer types as arguments

git-svn-id: trunk@47900 -

packages/fcl-passrc/src/pparser.pp

@@ -4943,7 +4943,7 @@ procedure TPasParser.ParseArgList(Parent: TPasElement; Args: TFPList; EndToken:
       end;
   end;
 var
-  IsUntyped, ok, LastHadDefaultValue: Boolean;
+  OldForceCaret,IsUntyped, ok, LastHadDefaultValue: Boolean;
   Name : String;
   Value : TPasExpr;
   i, OldArgCount: Integer;
@@ -5022,9 +5022,11 @@ begin
     if not IsUntyped then
       begin
       Arg := TPasArgument(Args[OldArgCount]);
-      ArgType := ParseType(Arg,CurSourcePos);
+      ArgType:=Nil;
       ok:=false;
+      oldForceCaret:=Scanner.SetForceCaret(True);
       try
+        ArgType := ParseType(Arg,CurSourcePos);
         NextToken;
         if CurToken = tkEqual then
           begin
@@ -5048,6 +5050,7 @@ begin
         UngetToken;
         ok:=true;
       finally
+        Scanner.SetForceCaret(oldForceCaret);
         if (not ok) and (ArgType<>nil) then
           ArgType.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
       end;

packages/fcl-passrc/tests/tcprocfunc.pas

@@ -102,6 +102,8 @@ type
     Procedure TestFunctionArrayOfConstArg;
     procedure TestProcedureConstArrayOfConstArg;
     Procedure TestFunctionConstArrayOfConstArg;
+    procedure TestProcedureOnePointerArg;
+
     Procedure TestProcedureCdecl;
     Procedure TestFunctionCdecl;
     Procedure TestProcedureCdeclDeprecated;
@@ -354,6 +356,7 @@ procedure TTestProcedureFunction.AssertArg(ProcType: TPasProcedureType;
 
 Var
   A : TPasArgument;
+  T : TPasType;
   N : String;
 
 begin
@@ -361,11 +364,21 @@ begin
   N:='Argument '+IntToStr(AIndex+1)+' : ';
   if (TypeName='') then
     AssertNull(N+' No argument type',A.ArgType)
-  else
+  else if TypeName[1]<>'^' then
     begin
     AssertNotNull(N+' Have argument type',A.ArgType);
     AssertEquals(N+' Correct argument type name',TypeName,A.ArgType.Name);
+    end
+  else  
+    begin
+    AssertNotNull(N+' Have argument type',A.ArgType);
+    T:=A.ArgType;
+    AssertEquals(N+' type Is pointer type',TPasPointerType,T.CLassType);
+    T:=TPasPointerType(T).DestType;
+    AssertNotNull(N+'Have dest type',T);
+    AssertEquals(N+' Correct argument dest type name',Copy(TypeName,2,MaxInt),T.Name);
     end;
+    
 end;
 
 procedure TTestProcedureFunction.AssertArrayArg(ProcType: TPasProcedureType;
@@ -481,6 +494,13 @@ begin
   AssertArg(ProcType,0,'B',argDefault,'Integer','');
 end;
 
+procedure TTestProcedureFunction.TestProcedureOnePointerArg;
+begin
+  ParseProcedure('(B : ^Integer)');
+  AssertProc([],[],ccDefault,1);
+  AssertArg(ProcType,0,'B',argDefault,'^Integer','');
+end;
+
 procedure TTestProcedureFunction.TestFunctionOneArg;
 begin
   ParseFunction('(B : Integer)');