* Record/Class operator parsing

git-svn-id: trunk@43229 -

packages/fcl-passrc/src/pparser.pp

@@ -3550,13 +3550,9 @@ begin
       SetBlock(declNone);
       SaveComments;
       NextToken;
-      If CurToken in [tkprocedure,tkFunction,tkConstructor,tkDestructor] then
-        begin
-        pt:=GetProcTypeFromToken(CurToken,True);
-        AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt, MustBeGeneric));
-        end
-      else
-        CheckToken(tkprocedure);
+      CheckTokens([tkprocedure,tkFunction,tkConstructor,tkDestructor,tkoperator]);
+      pt:=GetProcTypeFromToken(CurToken,True);
+      AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt, MustBeGeneric));
       end;
     tkIdentifier:
       begin
@@ -6501,12 +6497,14 @@ var
   end;
 
 var
-  Name: String;
+  N,Name: String;
   PC : TPTreeElement;
   Ot : TOperatorType;
   IsTokenBased , ok: Boolean;
   j, i: Integer;
+
 begin
+  N:='';
   NameParts:=nil;
   Result:=nil;
   ok:=false;
@@ -6521,10 +6519,28 @@ begin
       if IsTokenBased then
         OT:=TPasOperator.TokenToOperatorType(CurTokenText)
       else
+        begin
         OT:=TPasOperator.NameToOperatorType(CurTokenString);
+        N:=CurTokenString;
+        // Case Class operator TMyRecord.+
+        if (OT=otUnknown) then
+          begin
+          NextToken;
+          if CurToken<>tkDot then
+            ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,[N]);
+          NextToken;
+          IsTokenBased:=CurToken<>tkIdentifier;
+          if IsTokenBased then
+            OT:=TPasOperator.TokenToOperatorType(CurTokenText)
+          else
+            OT:=TPasOperator.NameToOperatorType(CurTokenString);
+          end;
+        end;
       if (ot=otUnknown) then
         ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,[CurTokenString]);
       Name:=OperatorNames[Ot];
+      if N<>'' then
+        Name:=N+'.'+Name;
       NamePos:=CurTokenPos;
       end;
     ptAnonymousProcedure,ptAnonymousFunction:

packages/fcl-passrc/tests/tctypeparser.pas

@@ -363,6 +363,7 @@ type
     Procedure TestAdvRec_DestructorFail;
     Procedure TestAdvRecordInFunction;
     Procedure TestAdvRecordInAnonFunction;
+    Procedure TestAdvRecordClassOperator;
   end;
 
   { TTestProcedureTypeParser }
@@ -2612,6 +2613,7 @@ end;
 procedure TTestRecordTypeParser.TestAdvRecordInFunction;
 
 // Src from bug report 36179
+
 Const
    Src =
     '{$mode objfpc}'+sLineBreak+
@@ -2630,10 +2632,13 @@ Const
 
 begin
   Source.Text:=Src;
-  ParseModule;
+  ParseModule; // We're just interested in that it parses.
 end;
 
 procedure TTestRecordTypeParser.TestAdvRecordInAnonFunction;
+
+// Src from bug report 36179, modified to put record in anonymous function - not allowed !
+
 Const
    Src =
     '{$mode objfpc}'+sLineBreak+
@@ -2651,11 +2656,37 @@ Const
     '  begin'+sLineBreak+
     '  end;'+sLineBreak+
     'end.';
+
 begin
   Source.Text:=Src;
   AssertException('Advanced records not allowed in anonymous function',EParserError,@ParseModule);
 end;
 
+procedure TTestRecordTypeParser.TestAdvRecordClassOperator;
+
+// Source from bug id 36180
+
+Const
+   SRC =
+    '{$mode objfpc}'+sLineBreak+
+    '{$modeswitch advancedrecords}'+sLineBreak+
+    'program afile;'+sLineBreak+
+    'type'+sLineBreak+
+    '  TMyRecord = record'+sLineBreak+
+    '    class operator = (a, b: TMyRecord): boolean;'+sLineBreak+
+    '  end;'+sLineBreak+
+    'class operator TMyRecord.= (a, b: TMyRecord): boolean;'+sLineBreak+
+    'begin'+sLineBreak+
+    '  result := (@a = @b);'+sLineBreak+
+    'end;'+sLineBreak+
+    'begin'+sLineBreak+
+    'end.';
+
+begin
+  Source.Text:=Src;
+  ParseModule;   // We're just interested in that it parses.
+end;
+
 { TBaseTestTypeParser }
 
 Function TBaseTestTypeParser.ParseType(ASource: String; ATypeClass: TClass;