* Fix bug #31719

git-svn-id: trunk@35960 -

packages/fcl-passrc/src/pparser.pp

@@ -1729,6 +1729,7 @@ var
   b       : TBinaryExpr;
   optk    : TToken;
   ok: Boolean;
+  S : String;
 
 begin
   Result:=nil;

packages/fcl-passrc/src/pscanner.pp

@@ -41,6 +41,7 @@ const
   nLogIFIgnored = 1014;
   nErrInvalidMode = 1015;
   nErrInvalidModeSwitch = 1016;
+  nUserDefined = 1017;
 
 // resourcestring patterns of messages
 resourcestring
@@ -60,6 +61,7 @@ resourcestring
   SLogIFIgnored = 'IF %s found, ignoring (rejected).';
   SErrInvalidMode = 'Invalid mode: "%s"';
   SErrInvalidModeSwitch = 'Invalid mode switch: "%s"';
+  SErrUserDefined = 'User defined error: "%s"';
 
 type
   TMessageType = (
@@ -458,6 +460,7 @@ type
     procedure HandleELSE(const AParam: String);
     procedure HandleENDIF(const AParam: String);
     procedure HandleDefine(Param: String); virtual;
+    procedure HandleError(Param: String); virtual;
     procedure HandleIncludeFile(Param: String); virtual;
     procedure HandleUnDefine(Param: String);virtual;
     function HandleInclude(const Param: String): TToken;virtual;
@@ -1593,6 +1596,11 @@ begin
     end;
 end;
 
+procedure TPascalScanner.HandleError(Param: String);
+begin
+  Error(nUserDefined, SErrUserDefined,[Param])
+end;
+
 procedure TPascalScanner.HandleUnDefine(Param: String);
 
 Var
@@ -1866,6 +1874,9 @@ begin
   'DEFINE':
      if not PPIsSkipping then
        HandleDefine(Param);
+  'ERROR':
+     if not PPIsSkipping then
+       HandleError(Param);
   'UNDEF':
      if not PPIsSkipping then
        HandleUnDefine(Param);
@@ -2229,7 +2240,7 @@ begin
     '^':
       begin
       if ForceCaret or PPisSkipping or
-         (PreviousToken in [tkeof,tkComment,tkIdentifier,tkNil,tkOperator,tkBraceClose,tkSquaredBraceClose,tkCARET]) then
+         (PreviousToken in [tkeof,tkComment,tkIdentifier,tkNil,tkOperator,tkBraceClose,tkSquaredBraceClose,tkCARET,tkWhitespace]) then
         begin
         Inc(TokenStr);
         Result := tkCaret;

packages/fcl-passrc/tests/tcexprparser.pas

@@ -135,6 +135,7 @@ type
     Procedure TestTypeCast;
     procedure TestTypeCast2;
     Procedure TestCreate;
+    procedure TestChainedPointers;
   end;
 
 implementation
@@ -581,6 +582,29 @@ begin
   ParseExpression('ESDOSerializationException.CreateFmt(SERR_InvalidDataTypeInContext,[IntToStr(Ord(AOwner^.DataType))])');
 end;
 
+procedure TTestExpressions.TestChainedPointers;
+begin
+  // From bug report 31719
+  Source.Add('type');
+  Source.Add('    PTResourceManager=^TResourceManager;');
+  Source.Add('    TResourceManager=object');
+  Source.Add('      function LoadResourceFromFile(filename:string):PTResourceManager;');
+  Source.Add('    end;');
+  Source.Add('    function TResourceManager.LoadResourceFromFile(filename:string):PTResourceManager;');
+  Source.Add('    begin');
+  Source.Add('      result:=@self;');
+  Source.Add('    end;');
+  Source.Add('');
+  Source.Add('  var');
+  Source.Add('    ResourceManager:TResourceManager;');
+  Source.Add('');
+  Source.Add('  begin');
+  Source.Add('    ResourceManager.LoadResourceFromFile(''file1'')');
+  Source.Add('                  ^.LoadResourceFromFile(''file2'');');
+  Source.Add('  end.');
+  ParseModule;
+end;
+
 
 procedure TTestExpressions.TestUnaryMinus;
 begin