* Advanced records structure changed, fixed fpdoc

git-svn-id: trunk@47510 -
(cherry picked from commit 5354cf2a619e306e6779b5e5d4853ed62c58a467)

packages/fcl-passrc/src/pastree.pp

@@ -1169,7 +1169,8 @@ type
     otBitwiseAnd, otbitwiseXor,
     otLogicalAnd, otLogicalNot, otLogicalXor,
     otRightShift,
-    otEnumerator, otIn
+    otEnumerator, otIn,
+    otInitialize // Management operator
     );
   TOperatorTypes = set of TOperatorType;
 
@@ -1751,13 +1752,13 @@ const
            '>',':=','<>','<=','>=','**',
            '><','Inc','Dec','mod','-','+','Or','div',
            'shl','or','and','xor','and','not','xor',
-           'shr','enumerator','in');
+           'shr','enumerator','in','');
   OperatorNames : Array[TOperatorType] of string
        =  ('','implicit','explicit','multiply','add','subtract','divide','lessthan','equal',
            'greaterthan','assign','notequal','lessthanorequal','greaterthanorequal','power',
            'symmetricaldifference','inc','dec','modulus','negative','positive','bitwiseor','intdivide',
            'leftshift','logicalor','bitwiseand','bitwisexor','logicaland','logicalnot','logicalxor',
-           'rightshift','enumerator','in');
+           'rightshift','enumerator','in','initialize');
 
   AssignKindNames : Array[TAssignKind] of string = (':=','+=','-=','*=','/=' );
 
@@ -2836,7 +2837,9 @@ begin
         Result := Result + ', ';
       Result := Result + TPasArgument(ProcType.Args[i]).ArgType.Name;
       end;
-    Result := Result + '): ' + TPasFunctionType(ProcType).ResultEl.ResultType.Name;
+    Result := Result + ')';
+    if (OperatorType<>otInitialize) and Assigned(TPasFunctionType(ProcType).ResultEl.ResultType) then
+       Result:=Result+': ' + TPasFunctionType(ProcType).ResultEl.ResultType.Name;
     If WithPath then
       begin
       S:=Self.ParentPath;

packages/fcl-passrc/src/pparser.pp

@@ -5356,13 +5356,17 @@ begin
         begin
         ResultEl.Name := CurTokenName;
         ExpectToken(tkColon);
-        end
-      else
-        if (CurToken=tkColon) then
-          ResultEl.Name := 'Result'
-        else
-          ParseExc(nParserExpectedColonID,SParserExpectedColonID);
         ResultEl.ResultType := ParseType(ResultEl,CurSourcePos);
+        end
+      else if not ((Parent is TPasOperator) and (TPasOperator(Parent).OperatorType=otInitialize)) then
+        // Initialize operator has no result
+        begin
+         if (CurToken=tkColon) then
+            ResultEl.Name := 'Result'
+          else
+            ParseExc(nParserExpectedColonID,SParserExpectedColonID);
+         ResultEl.ResultType := ParseType(ResultEl,CurSourcePos);
+         end;
       end;
   else
     ResultEl:=Nil;
@@ -6883,7 +6887,10 @@ Var
   CurEl: TPasElement;
   LastToken: TToken;
   AllowVisibility: Boolean;
+  IsGeneric : Boolean;
+
 begin
+  IsGeneric:=False;
   AllowVisibility:=msAdvancedRecords in CurrentModeswitches;
   if AllowVisibility then
     v:=visPublic
@@ -6969,7 +6976,7 @@ begin
         if Not AllowMethods then
           ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
         ProcType:=GetProcTypeFromToken(CurToken,LastToken=tkclass);
-        Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,false,v);
+        Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,IsGeneric,v);
         if Proc.Parent is TPasOverloadedProc then
           TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
         else
@@ -6978,9 +6985,21 @@ begin
         end;
       tkDestructor:
         ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
-      tkabsolute,tkGeneric,tkSelf, // Counts as field name
+      tkGeneric, // Can count as field name
+      tkabsolute,
+      tkSelf, // Count as field name
       tkIdentifier :
         begin
+        if (Curtoken=tkGeneric) and AllowVisibility then
+          begin
+          NextToken;
+          if CurToken in [tkClass,tkOperator,tkFunction,tkProcedure] then
+            begin
+            IsGeneric:=True;
+            Continue;
+            end;
+          UnGetToken;
+          end;
         If AllowVisibility and CheckVisibility(CurTokenString,v) then
           begin
           if not (v in [visPrivate,visPublic,visStrictPrivate]) then
@@ -7034,6 +7053,8 @@ begin
       break;
     LastToken:=CurToken;
     NextToken;
+    if not IsClass then
+      IsGeneric:=False;
     end;
 end;
 

packages/fcl-passrc/tests/tcprocfunc.pas

@@ -178,6 +178,7 @@ type
     Procedure TestProcedureCdeclExternalName;
     Procedure TestFunctionCdeclExternalName;
     Procedure TestFunctionAlias;
+    Procedure TestOperatorNamedResult;
     Procedure TestOperatorTokens;
     procedure TestOperatorNames;
     Procedure TestAssignOperatorAfterObject;
@@ -1312,6 +1313,13 @@ begin
   AssertEquals('Alias name','''myalias''',Func.AliasName);
 end;
 
+procedure TTestProcedureFunction.TestOperatorNamedResult;
+begin
+  AddDeclaration('operator = (a,b : T) z : Integer;');
+  ParseOperator;
+  AssertEquals('Correct operator type',otEqual,FOperator.OperatorType);
+end;
+
 procedure TTestProcedureFunction.TestProcedureAlias;
 begin
   AddDeclaration('Procedure A; Alias : ''myalias''');

packages/fcl-passrc/tests/tctypeparser.pas

@@ -368,6 +368,8 @@ type
     Procedure TestAdvRecordInFunction;
     Procedure TestAdvRecordInAnonFunction;
     Procedure TestAdvRecordClassOperator;
+    Procedure TestAdvRecordInitOperator;
+    Procedure TestAdvRecordGenericFunction;
   end;
 
   { TTestProcedureTypeParser }
@@ -2715,6 +2717,51 @@ begin
   ParseModule;   // We're just interested in that it parses.
 end;
 
+procedure TTestRecordTypeParser.TestAdvRecordInitOperator;
+// Source from bug id 36180
+
+Const
+   SRC =
+    '{$mode objfpc}'+sLineBreak+
+    '{$modeswitch advancedrecords}'+sLineBreak+
+    'program afile;'+sLineBreak+
+    'type'+sLineBreak+
+    '  TMyRecord = record'+sLineBreak+
+    '    class operator initialize (var self: TMyRecord);'+sLineBreak+
+    '  end;'+sLineBreak+
+    'class operator TMyRecord.initialize (a, b: TMyRecord);'+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;
+
+procedure TTestRecordTypeParser.TestAdvRecordGenericFunction;
+
+Const
+   SRC =
+    '{$mode objfpc}'+sLineBreak+
+    '{$modeswitch advancedrecords}'+sLineBreak+
+    'program afile;'+sLineBreak+
+    'type'+sLineBreak+
+    '  TMyRecord = record'+sLineBreak+
+    '    generic class procedure doit<T> (a: T);'+sLineBreak+
+    '  end;'+sLineBreak+
+    'generic class procedure TMyRecord.DoIt<T>(a: T);'+sLineBreak+
+    'begin'+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;

packages/pastojs/src/pas2jsfiler.pp

@@ -485,7 +485,8 @@ const
     'LogicalXor',
     'RightShift',
     'Enumerator',
-    'In'
+    'In',
+    'Initialize'
     );
 
   PCUProcedureModifierNames: array[TProcedureModifier] of string = (

utils/fpdoc/dglobals.pp

@@ -1056,7 +1056,8 @@ var
   i, j, k: Integer;
   Module: TPasModule;
   Alias : TPasAliasType;
-  ClassDecl: TPasClassType;
+  MemberDecl: TPasMembersType;
+  ClassLikeDecl : TPasClassType;
   Member: TPasElement;
   s: String;
   Buf : TBufType;
@@ -1089,41 +1090,48 @@ begin
       if not assigned(Module.InterfaceSection) then
         continue;
       for j := 0 to Module.InterfaceSection.Classes.Count - 1 do
-      begin
-        ClassDecl := TPasClassType(Module.InterfaceSection.Classes[j]);
-        Write(ContentFile, CheckImplicitInterfaceLink(ClassDecl.PathName), ' ');
-        if Assigned(ClassDecl.AncestorType) then 
+        begin
+        MemberDecl := TPasClassType(Module.InterfaceSection.Classes[j]);
+        if MemberDecl is TPasClassType then
+          ClassLikeDecl:=MemberDecl as TPasClassType
+        else
+          ClassLikeDecl:=nil;
+        Write(ContentFile, CheckImplicitInterfaceLink(MemberDecl.PathName), ' ');
+        if Assigned(ClassLikeDecl) then
           begin
-             // simple aliases to class types are coded as "alias(classtype)"
-             Write(ContentFile, CheckImplicitInterfaceLink(ClassDecl.AncestorType.PathName));
-             if ClassDecl.AncestorType is TPasAliasType then
+          if Assigned(ClassLikeDecl.AncestorType) then
+            begin
+            // simple aliases to class types are coded as "alias(classtype)"
+            Write(ContentFile, CheckImplicitInterfaceLink(ClassLikeDecl.AncestorType.PathName));
+            if ClassLikeDecl.AncestorType is TPasAliasType then
                begin
-                 alias:= TPasAliasType(ClassDecl.AncestorType);
-                 if assigned(alias.desttype) and (alias.desttype is TPasClassType) then
-                   write(ContentFile,'(',alias.desttype.PathName,')');   
+               alias:= TPasAliasType(ClassLikeDecl.AncestorType);
+               if assigned(alias.desttype) and (alias.desttype is TPasClassType) then
+                  write(ContentFile,'(',alias.desttype.PathName,')');
                end;
-          end
-        else if ClassDecl.ObjKind = okClass then
-          Write(ContentFile, '#rtl.System.TObject')
-        else if ClassDecl.ObjKind = okInterface then
-          Write(ContentFile, '#rtl.System.IUnknown');
-        if ClassDecl.Interfaces.Count>0 then
-          begin
-            for k:=0 to ClassDecl.Interfaces.count-1 do
+            end
+          else if ClassLikeDecl.ObjKind = okClass then
+            Write(ContentFile, '#rtl.System.TObject')
+          else if ClassLikeDecl.ObjKind = okInterface then
+           Write(ContentFile, '#rtl.System.IUnknown');
+          if ClassLikeDecl.Interfaces.Count>0 then
+            begin
+            for k:=0 to ClassLikeDecl.Interfaces.count-1 do
               begin
-                write(contentfile,',',CheckImplicitInterfaceLink(TPasClassType(ClassDecl.Interfaces[k]).PathName));
-                if TPasElement(ClassDecl.Interfaces[k]) is TPasAliasType then
+                write(contentfile,',',CheckImplicitInterfaceLink(TPasClassType(ClassLikeDecl.Interfaces[k]).PathName));
+                if TPasElement(ClassLikeDecl.Interfaces[k]) is TPasAliasType then
                   begin
-                    alias:= TPasAliasType(ClassDecl.Interfaces[k]);
+                    alias:= TPasAliasType(ClassLikeDecl.Interfaces[k]);
                     if assigned(alias.desttype) and (alias.desttype is TPasClassType) then
                       write(ContentFile,'(',CheckImplicitInterfaceLink(alias.desttype.PathName),')');   
                   end;
               end;
+            end;
           end;
         writeln(contentfile);
-        for k := 0 to ClassDecl.Members.Count - 1 do
+        for k := 0 to MemberDecl.Members.Count - 1 do
         begin
-          Member := TPasElement(ClassDecl.Members[k]);
+          Member := TPasElement(MemberDecl.Members[k]);
           Write(ContentFile, Chr(Ord(Member.Visibility) + Ord('0')));
           S:='';
           if Member.ClassType = TPasVariable then