Browse Source

--- Merging r31168 into '.':
U packages/fcl-passrc/src/pparser.pp
U packages/fcl-passrc/src/pastree.pp
U packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r31168 into '.':
U .
--- Merging r31226 into '.':
U packages/fcl-passrc/tests/tctypeparser.pas
U packages/fcl-passrc/tests/tcprocfunc.pas
U packages/fcl-passrc/tests/testpassrc.lpi
U packages/fcl-passrc/tests/tcbaseparser.pas
G packages/fcl-passrc/src/pastree.pp
G packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r31226 into '.':
G .
--- Merging r31228 into '.':
G packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r31228 into '.':
G .
--- Merging r31229 into '.':
G packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r31229 into '.':
G .
--- Merging r31230 into '.':
U utils/fpdoc/mkfpdoc.pp
--- Recording mergeinfo for merge of r31230 into '.':
G .
--- Merging r31231 into '.':
U utils/fpdoc/makeskel.pp
--- Recording mergeinfo for merge of r31231 into '.':
G .
--- Merging r31232 into '.':
U utils/fpdoc/dw_html.pp
--- Recording mergeinfo for merge of r31232 into '.':
G .
--- Merging r31233 into '.':
U utils/fpdoc/dglobals.pp
--- Recording mergeinfo for merge of r31233 into '.':
G .
--- Merging r31234 into '.':
U utils/fpdoc/testunit.pp
A utils/fpdoc/gentest.sh
U utils/fpdoc/testunit.xml
--- Recording mergeinfo for merge of r31234 into '.':
G .

# revisions: 31168,31226,31228,31229,31230,31231,31232,31233,31234

git-svn-id: branches/fixes_3_0@31269 -

marco 10 years ago
parent
commit
a9899845ee

+ 1 - 0
.gitattributes

@@ -15179,6 +15179,7 @@ utils/fpdoc/fpdocstripper.lpi svneol=native#text/plain
 utils/fpdoc/fpdocstripper.pp svneol=native#text/plain
 utils/fpdoc/fpdocxmlopts.pas svneol=native#text/plain
 utils/fpdoc/fpmake.pp svneol=native#text/plain
+utils/fpdoc/gentest.sh svneol=native#text/plain
 utils/fpdoc/images/minus.png -text svneol=unset#image/png
 utils/fpdoc/images/plus.png -text svneol=unset#image/png
 utils/fpdoc/intl/Makefile svneol=native#text/plain

+ 194 - 13
packages/fcl-passrc/src/pastree.pp

@@ -65,6 +65,8 @@ resourcestring
   SPasTreeOverloadedProcedure = 'overloaded procedure';
   SPasTreeProcedure = 'procedure';
   SPasTreeFunction = 'function';
+  SPasTreeOperator = 'operator';
+  SPasTreeClassOperator = 'class operator';
   SPasTreeClassProcedure = 'class procedure';
   SPasTreeClassFunction = 'class function';
   SPasTreeClassConstructor = 'class constructor';
@@ -91,7 +93,7 @@ type
     visPublished, visAutomated,
     visStrictPrivate, visStrictProtected);
 
-  TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall);
+  TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall,ccSysCall);
   TPackMode = (pmNone,pmPacked,pmBitPacked);
 
   TPasMemberVisibilities = set of TPasMemberVisibility;
@@ -121,8 +123,10 @@ type
     constructor Create(const AName: string; AParent: TPasElement); virtual;
     procedure AddRef;
     procedure Release;
-    function FullName: string;          // Name including parent's names
-    function PathName: string;          // = Module.Name + FullName
+    function FullPath: string;
+    function ParentPath: string;
+    function FullName: string; virtual;         // Name including parent's names
+    function PathName: string; virtual;         // = Module.Name + FullName
     function GetModule: TPasModule;
     function ElementTypeName: string; virtual;
     Function HintsString : String;
@@ -765,14 +769,43 @@ type
   end;
 
   { TPasOperator }
-
-  TPasOperator = class(TPasProcedure)
-  public
+  TOperatorType = (otUnknown,otImplicit,otExplicit,otMul,otPlus, otMinus, otDivision,otLessThan, otEqual,
+                   otGreaterThan, otAssign,otNotEqual,otLessEqualThan,otGreaterEqualThan,otPower,
+                   otSymmetricalDifference, otInc, otDec, otMod, otNegative, otPositive, otBitWiseOr, otDiv,
+                   otLeftShift, otLogicalOr, otBitwiseAnd, otbitwiseXor,otLogicalAnd,otLogicalNot,otLogicalXor,
+                   otRightShift);
+  TOperatorTypes = set of TOperatorType;
+
+  TPasOperator = class(TPasFunction)
+  private
+    FOperatorType: TOperatorType;
+    FTokenBased: Boolean;
+    function NameSuffix: String;
+  public
+    Class Function OperatorTypeToToken(T : TOperatorType) : String;
+    Class Function OperatorTypeToOperatorName(T: TOperatorType) : String;
+    Class Function TokenToOperatorType(S : String) : TOperatorType;
+    Class Function NameToOperatorType(S : String) : TOperatorType;
+    Procedure CorrectName;
+    // For backwards compatibility the old name can still be used to search on.
+    function GetOperatorDeclaration(Full: Boolean): string;
+    Function OldName(WithPath : Boolean) : String;
     function ElementTypeName: string; override;
     function TypeName: string; override;
     function GetDeclaration (full : boolean) : string; override;
+    Property OperatorType : TOperatorType Read FOperatorType Write FOperatorType;
+    // True if the declaration was using a token instead of a
+    Property TokenBased : Boolean Read FTokenBased Write FTokenBased;
+  end;
+
+Type
+  { TPasClassOperator }
+
+  TPasClassOperator = class(TPasOperator)
+    function TypeName: string; override;
   end;
 
+
   { TPasConstructor }
 
   TPasConstructor = class(TPasProcedure)
@@ -1184,10 +1217,26 @@ const
         '@','^',
         '.');
 
+
+  UnaryOperators = [otImplicit,otExplicit,otAssign,otNegative,otPositive];
+
+  OperatorTokens : Array[TOperatorType] of string
+       =  ('','','','*','+','-','/','<','=',
+           '>',':=','<>','<=','>=','**',
+           '><','Inc','Dec','mod','-','+','Or','div',
+           'shl','or','and','xor','and','not','xor',
+           'shr');
+  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');
+
   cPasMemberHint : array[TPasMemberHint] of string =
       ( 'deprecated', 'library', 'platform', 'experimental', 'unimplemented' );
   cCallingConventions : array[TCallingConvention] of string =
-      ( '', 'Register','Pascal','CDecl','StdCall','OldFPCCall','SafeCall');
+      ( '', 'Register','Pascal','CDecl','StdCall','OldFPCCall','SafeCall','SysCall');
 
   ModifierNames : Array[TProcedureModifier] of string
                 = ('virtual', 'dynamic','abstract', 'override',
@@ -1199,6 +1248,13 @@ implementation
 
 uses SysUtils;
 
+{ TPasClassOperator }
+
+function TPasClassOperator.TypeName: string;
+begin
+  Result:='class operator';
+end;
+
 { TPasImplAsmStatement }
 
 constructor TPasImplAsmStatement.Create(const AName: string;
@@ -1412,7 +1468,90 @@ begin
 end;
 
 function TPasClassFunction.ElementTypeName: string; begin Result := SPasTreeClassFunction; end;
-function TPasOperator.ElementTypeName: string; begin Result := SPasTreeFunction end;
+
+class function TPasOperator.OperatorTypeToToken(T: TOperatorType): String;
+begin
+  Result:=OperatorTokens[T];
+end;
+
+class function TPasOperator.OperatorTypeToOperatorName(T: TOperatorType
+  ): String;
+begin
+  Result:=OperatorNames[T];
+end;
+
+class function TPasOperator.TokenToOperatorType(S: String): TOperatorType;
+begin
+  Result:=High(TOperatorType);
+  While (Result>otUnknown) and (CompareText(S,OperatorTokens[Result])<>0) do
+    Result:=Pred(Result);
+end;
+
+class function TPasOperator.NameToOperatorType(S: String): TOperatorType;
+begin
+  Result:=High(TOperatorType);
+  While (Result>otUnknown) and (CompareText(S,OperatorNames[Result])<>0) do
+    Result:=Pred(Result);
+end;
+
+Function TPasOperator.NameSuffix : String;
+
+Var
+  I : Integer;
+
+begin
+  Result:='(';
+  if Assigned(ProcType) and Assigned(ProcType.Args) then
+  for i:=0 to ProcType.Args.Count-1 do
+    begin
+    if i>0 then
+      Result:=Result+',';
+    Result:=Result+TPasArgument(ProcType.Args[i]).ArgType.Name;
+    end;
+  Result:=Result+')';
+  if Assigned(TPasFunctionType(ProcType)) and
+     Assigned(TPasFunctionType(ProcType).ResultEl) and
+     Assigned(TPasFunctionType(ProcType).ResultEl.ResultType) then
+    Result:=Result+':'+TPasFunctionType(ProcType).ResultEl.ResultType.Name;
+end;
+
+procedure TPasOperator.CorrectName;
+
+begin
+  Name:=OperatorNames[OperatorType]+NameSuffix;
+end;
+
+function TPasOperator.OldName(WithPath : Boolean): String;
+
+Var
+  I : Integer;
+  S : String;
+begin
+  Result:=TypeName+' '+OperatorTokens[OperatorType];
+  Result := Result + '(';
+  if Assigned(ProcType) then
+    begin
+    for i := 0 to ProcType.Args.Count - 1 do
+      begin
+      if i > 0 then
+        Result := Result + ', ';
+      Result := Result + TPasArgument(ProcType.Args[i]).ArgType.Name;
+      end;
+    Result := Result + '): ' + TPasFunctionType(ProcType).ResultEl.ResultType.Name;
+    If WithPath then
+      begin
+      S:=Self.ParentPath;
+      if (S<>'') then
+        Result:=S+'.'+Result;
+      end;
+    end;
+end;
+
+function TPasOperator.ElementTypeName: string;
+begin
+  Result := SPasTreeOperator
+end;
+
 function TPasConstructor.ElementTypeName: string; begin Result := SPasTreeConstructor end;
 function TPasDestructor.ElementTypeName: string; begin Result := SPasTreeDestructor end;
 function TPasProcedureImpl.ElementTypeName: string; begin Result := SPasTreeProcedureImpl end;
@@ -1545,11 +1684,13 @@ begin
 {$ifdef debugrefcount}  Writeln('Released : ',Cn); {$endif}
 end;
 
-function TPasElement.FullName: string;
+function TPasElement.FullPath: string;
+
 var
   p: TPasElement;
+
 begin
-  Result := Name;
+  Result := '';
   p := Parent;
   while Assigned(p) and not p.InheritsFrom(TPasDeclarations) do
   begin
@@ -1562,11 +1703,23 @@ begin
   end;
 end;
 
-function TPasElement.PathName: string;
+function TPasElement.FullName: string;
+
+
+begin
+  Result := FullPath;
+  if Result<>'' then
+    Result:=Result+'.'+Name
+  else
+    Result:=Name;
+end;
+
+function TPasElement.ParentPath: string;
+
 var
   p: TPasElement;
 begin
-  Result := Name;
+  Result:='';
   p := Parent;
   while Assigned(p) do
   begin
@@ -1579,6 +1732,16 @@ begin
   end;
 end;
 
+function TPasElement.PathName: string;
+
+begin
+  Result := ParentPath;
+  if Result<>'' then
+    Result:=Result+'.'+Name
+  else
+    Result:=Name;
+end;
+
 function TPasElement.GetModule: TPasModule;
 begin
   if self is  TPasPackage then
@@ -2944,6 +3107,23 @@ begin
   Result:='function';
 end;
 
+function TPasOperator.GetOperatorDeclaration(Full : Boolean) : string;
+
+begin
+  if Full then
+    begin
+    Result:=FullPath;
+    if (Result<>'') then
+      Result:=Result+'.';
+    end
+  else
+    Result:='';
+  if TokenBased then
+    Result:=Result+TypeName+' '+OperatorTypeToToken(OperatorType)
+  else
+    Result:=Result+TypeName+' '+OperatorTypeToOperatorName(OperatorType);
+end;
+
 function TPasOperator.GetDeclaration (full : boolean) : string;
 
 Var
@@ -2954,7 +3134,7 @@ begin
   S:=TStringList.Create;
   try
     If Full then
-      S.Add(TypeName+' '+Name);
+      S.Add(GetOperatorDeclaration(Full));
     ProcType.GetArguments(S);
     If Assigned((Proctype as TPasFunctionType).ResultEl) then
       With TPasFunctionType(ProcType).ResultEl.ResultType do
@@ -2968,6 +3148,7 @@ begin
         end;
     GetModifiers(S);
     Result:=IndentStrings(S,Length(S[0]));
+
   finally
     S.Free;
   end;

+ 105 - 46
packages/fcl-passrc/src/pparser.pp

@@ -38,6 +38,7 @@ resourcestring
   SParserExpectedCommaSemicolon = 'Expected "," or ";"';
   SParserExpectedAssignIn = 'Expected := or in';
   SParserExpectedCommaColon = 'Expected "," or ":"';
+  SErrUnknownOperatorType = 'Unknown operator type: %s';
   SParserOnlyOneArgumentCanHaveDefault = 'A default value can only be assigned to 1 parameter';
   SParserExpectedLBracketColon = 'Expected "(" or ":"';
   SParserExpectedLBracketSemicolon = 'Expected "(" or ";"';
@@ -63,6 +64,7 @@ resourcestring
   SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Record helpers';
   SParserNoFieldsAllowed = 'Fields are not allowed in Interfaces';
   SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers';
+  SErrRecordConstantsNotAllowed = 'Record constants not allowed at this location.';
   SErrRecordMethodsNotAllowed = 'Record methods not allowed at this location.';
   SErrRecordPropertiesNotAllowed = 'Record properties not allowed at this location.';
   SErrRecordVisibilityNotAllowed = 'Record visibilities not allowed at this location.';
@@ -119,7 +121,7 @@ type
     property Column: Integer read FColumn;
   end;
 
-  TProcType = (ptProcedure, ptFunction, ptOperator, ptConstructor, ptDestructor,
+  TProcType = (ptProcedure, ptFunction, ptOperator, ptClassOperator, ptConstructor, ptDestructor,
                ptClassProcedure, ptClassFunction, ptClassConstructor, ptClassDestructor);
 
 
@@ -175,6 +177,7 @@ type
     function CheckProcedureArgs(Parent: TPasElement; Args: TFPList; Mandatory: Boolean): boolean;
     function CheckVisibility(S: String; var AVisibility: TPasMemberVisibility): Boolean;
     procedure ParseExc(const Msg: String);
+    procedure ParseExc(const Fmt: String; Args : Array of const);
     function OpLevel(t: TToken): Integer;
     Function TokenToExprOp (AToken : TToken) : TExprOpCode;
     function CreateElement(AClass: TPTreeElement; const AName: String; AParent: TPasElement): TPasElement;overload;
@@ -311,7 +314,7 @@ Function IsCallingConvention(S : String; out CC : TCallingConvention) : Boolean;
 
 Var
   CCNames : Array[TCallingConvention] of String
-         = ('','register','pascal','cdecl','stdcall','oldfpccall','safecall');
+         = ('','register','pascal','cdecl','stdcall','oldfpccall','safecall','syscall');
 Var
   C : TCallingConvention;
 
@@ -399,7 +402,7 @@ var
           if  (length(s)>2) then
             case S[3] of
               'c' : Scanner.Options:=Scanner.Options+[po_cassignments];
-              'd' : Parser.Options:=Parser.Options+[po_delphi];
+              'd','2' : Parser.Options:=Parser.Options+[po_delphi];
             end;
       end;
     end else
@@ -447,7 +450,13 @@ begin
     else if s = 'BEOS' then
       Scanner.AddDefine('UNIX')
     else if s = 'QNX' then
-      Scanner.AddDefine('UNIX');
+      Scanner.AddDefine('UNIX')
+    else if s = 'AROS' then
+      Scanner.AddDefine('HASAMIGA')
+    else if s = 'MORPHOS' then
+      Scanner.AddDefine('HASAMIGA')
+    else if s = 'AMIGA' then
+      Scanner.AddDefine('HASAMIGA');
 
     // TargetCPU
     s := UpperCase(CPUTarget);
@@ -550,6 +559,11 @@ begin
     Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn);
 end;
 
+procedure TPasParser.ParseExc(const Fmt: String; Args: array of const);
+begin
+  ParseExc(Format(Fmt,Args));
+end;
+
 constructor TPasParser.Create(AScanner: TPascalScanner;
   AFileResolver: TBaseFileResolver; AEngine: TPasTreeContainer);
 begin
@@ -1937,7 +1951,10 @@ begin
       else
         Result:=ptDestructor;
     tkOperator:
-      Result:=ptOperator;
+      if IsClass then
+        Result:=ptClassOperator
+      else
+        Result:=ptOperator;
   else
     ParseExc(SParserNotAProcToken);
   end;
@@ -2696,6 +2713,11 @@ begin
       end;
 
       NextToken;
+      if (CurToken = tkIdentifier) and (LowerCase(CurTokenString) = 'location') then
+        begin
+          NextToken; // remove 'location'
+          NextToken; // remove register
+        end;
       if CurToken = EndToken then
         break;
     end;
@@ -2856,24 +2878,21 @@ procedure TPasParser.ParseProcedureOrFunctionHeader(Parent: TPasElement;
 
 Var
   Tok : String;
-  i: Integer;
-  Proc: TPasProcedure;
   CC : TCallingConvention;
   PM : TProcedureModifier;
   Done: Boolean;
 
 begin
-  CheckProcedureArgs(Parent,Element.Args,ProcType=ptOperator);
+  // Element must be non-nil. Removed all checks for not-nil.
+  // If it is nil, the following fails anyway.
+  CheckProcedureArgs(Parent,Element.Args,ProcType in [ptOperator,ptClassOperator]);
   case ProcType of
     ptFunction,ptClassFunction:
       begin
       ExpectToken(tkColon);
-      if Assigned(Element) then        // !!!
-        TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
-      else
-        ParseType(nil);
+      TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
       end;
-    ptOperator:
+    ptOperator,ptClassOperator:
       begin
       NextToken;
       if (CurToken=tkIdentifier) then
@@ -2886,10 +2905,7 @@ begin
           TPasFunctionType(Element).ResultEl.Name := 'Result'
         else
           ParseExc(SParserExpectedColonID);
-        if Assigned(Element) then        // !!!
-          TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
-        else
-          ParseType(nil);
+        TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
       end;
   end;
   if OfObjectPossible then
@@ -2923,8 +2939,21 @@ begin
     NextToken;
     If TokenisCallingConvention(CurTokenString,cc) then
       begin
-      if Assigned(Element) then        // !!!
-        Element.CallingConvention:=Cc;
+      Element.CallingConvention:=Cc;
+      if cc = ccSysCall then
+      begin
+        // remove LibBase
+        NextToken;
+        if CurToken=tkSemiColon then
+          UngetToken
+        else
+          // remove legacy or basesysv on MorphOS syscalls
+          begin
+          if CurTokenIsIdentifier('legacy') or CurTokenIsIdentifier('BaseSysV') then
+            NextToken;
+          NextToken; // remove offset
+          end;
+      end;
       ExpectToken(tkSemicolon);
       end
     else if TokenIsProcedureModifier(Parent,CurTokenString,pm) then
@@ -2962,21 +2991,8 @@ begin
   Until Done;
   if DoCheckHint then  // deprecated,platform,experimental,library, unimplemented etc
     ConsumeSemi;
-  if (ProcType = ptOperator) and (Parent is TPasProcedure) then
-  begin
-    Proc:=TPasProcedure(Parent);
-    Proc.Name := Proc.Name + '(';
-    for i := 0 to Proc.ProcType.Args.Count - 1 do
-    begin
-      if i > 0 then
-        Proc.Name := Proc.Name + ', ';
-      Proc.Name := Proc.Name +
-        TPasArgument(Proc.ProcType.Args[i]).ArgType.Name;
-    end;
-    Proc.Name := Proc.Name + '): ' +
-      TPasFunctionType(Proc.ProcType).ResultEl.ResultType.Name;
-  end;
-
+  if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
+    TPasOperator(Parent).CorrectName;
   if (Parent is TPasProcedure)
   and (not TPasProcedure(Parent).IsForward)
   and (not TPasProcedure(Parent).IsExternal)
@@ -3639,12 +3655,13 @@ begin
     ptFunction       : Result:=TPasFunction;
     ptClassFunction  : Result:=TPasClassFunction;
     ptClassProcedure : Result:=TPasClassProcedure;
-    ptClassConstructor  : Result:=TPasClassConstructor;
-    ptClassDestructor   : Result:=TPasClassDestructor;
+    ptClassConstructor : Result:=TPasClassConstructor;
+    ptClassDestructor  : Result:=TPasClassDestructor;
     ptProcedure      : Result:=TPasProcedure;
     ptConstructor    : Result:=TPasConstructor;
     ptDestructor     : Result:=TPasDestructor;
     ptOperator       : Result:=TPasOperator;
+    ptClassOperator  : Result:=TPasClassOperator;
   else
     ParseExc('Unknown procedure Type '+intToStr(Ord(ProcType)));
   end;
@@ -3670,28 +3687,60 @@ function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType:
 var
   Name: String;
   PC : TPTreeElement;
+  Ot : TOperatorType;
+  IsTokenBased : Boolean;
 
 begin
-  If (ProcType<>ptOperator) then
+  If (Not (ProcType in [ptOperator,ptClassOperator])) then
     Name:=ExpectProcName
   else
     begin
     NextToken;
-    Name := 'operator ' + TokenInfos[CurToken];
+    IsTokenBased:=Curtoken<>tkIdentifier;
+    if IsTokenBased then
+      OT:=TPasOperator.TokenToOperatorType(CurTokenText)
+    else
+      OT:=TPasOperator.NameToOperatorType(CurTokenString);
+    if (ot=otUnknown) then
+      ParseExc(SErrUnknownOperatorType,[CurTokenString]);
+    Name:=OperatorNames[Ot];
     end;
   PC:=GetProcedureClass(ProcType);
   Parent:=CheckIfOverLoaded(Parent,Name);
   Result:=TPasProcedure(CreateElement(PC,Name,Parent,AVisibility));
   try
-    if ProcType in [ptFunction, ptClassFunction] then
-      Result.ProcType := CreateFunctionType('', 'Result', Result, True)
-    else if ProcType=ptOperator then
-      Result.ProcType := CreateFunctionType('', '__INVALID__', Result,True)
+    if Not (ProcType in [ptFunction, ptClassFunction, ptOperator, ptClassOperator]) then
+      Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result))
     else
-      Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result));
+      begin
+      Result.ProcType := CreateFunctionType('', 'Result', Result, True);
+      if (ProcType in [ptOperator, ptClassOperator]) then
+        begin
+        TPasOperator(Result).TokenBased:=IsTokenBased;
+        TPasOperator(Result).OperatorType:=OT;
+        TPasOperator(Result).CorrectName;
+        end;
+      end;
     ParseProcedureOrFunctionHeader(Result, Result.ProcType, ProcType, False);
     Result.Hints:=Result.ProcType.Hints;
-    Result.HintMessage:=Result.ProcType.HintMessage
+    Result.HintMessage:=Result.ProcType.HintMessage;
+    // + is detected as 'positive', but is in fact Add if there are 2 arguments.
+    if (ProcType in [ptOperator, ptClassOperator]) then
+      With TPasOperator(Result) do
+        begin
+        if (OperatorType in [otPositive, otNegative]) then
+          begin
+          if (ProcType.Args.Count>1) then
+            begin
+            Case OperatorType of
+              otPositive : OperatorType:=otPlus;
+              otNegative : OperatorType:=otMinus;
+            end;
+            Name:=OperatorNames[OperatorType];
+            TPasOperator(Result).CorrectName;
+            end;
+          end;
+        end;
   except
     FreeAndNil(Result);
     Raise;
@@ -3756,6 +3805,7 @@ Var
   Proc: TPasProcedure;
   ProcType: TProcType;
   Prop : TPasProperty;
+  Cons : TPasConst;
   isClass : Boolean;
 
 begin
@@ -3765,6 +3815,14 @@ begin
     begin
     SaveComments;
     Case CurToken of
+      tkConst:
+        begin
+        if Not AllowMethods then
+          ParseExc(SErrRecordConstantsNotAllowed);
+        ExpectToken(tkIdentifier);
+        Cons:=ParseConstDecl(ARec);
+        ARec.members.Add(Cons);
+        end;
       tkClass:
         begin
         if Not AllowMethods then
@@ -3782,6 +3840,7 @@ begin
         Prop.isClass:=isClass;
         Arec.Members.Add(Prop);
         end;
+      tkOperator,
       tkProcedure,
       tkFunction :
         begin
@@ -3828,10 +3887,10 @@ begin
     else
       ParseExc(SParserTypeSyntaxError);
     end;
-    if CurToken<>AEndToken then
-      NextToken;
     If CurToken<>tkClass then
       isClass:=False;
+    if CurToken<>AEndToken then
+      NextToken;
     end;
 end;
 

+ 1 - 1
packages/fcl-passrc/src/pscanner.pp

@@ -1647,7 +1647,7 @@ begin
                 else if Param[1]='%' then
                   begin
                   fcurtokenstring:='{$i '+param+'}';
-                  fcurtoken:=tkstring;  
+                  fcurtoken:=tkstring;
                   result:=fcurtoken;
                   exit;
                   end

+ 34 - 2
packages/fcl-passrc/tests/tcbaseparser.pas

@@ -43,6 +43,8 @@ Type
     FUseImplementation: Boolean;
     function GetPL: TPasLibrary;
     function GetPP: TPasProgram;
+    procedure CleanupParser;
+    procedure SetupParser;
   protected
     procedure SetUp; override;
     procedure TearDown; override;
@@ -56,6 +58,7 @@ Type
     Procedure StartParsing;
     Procedure ParseDeclarations;
     Procedure ParseModule;
+    procedure ResetParser;
     Procedure CheckHint(AHint : TPasMemberHint);
     Function AssertExpression(Const Msg: String; AExpr : TPasExpr; aKind : TPasExprKind; AClass : TClass) : TPasExpr;
     Function AssertExpression(Const Msg: String; AExpr : TPasExpr; aKind : TPasExprKind; AValue : String) : TPrimitiveExpr;
@@ -74,6 +77,7 @@ Type
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureModifiers); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TAssignKind); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureMessageType); overload;
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TOperatorType); overload;
     Procedure HaveHint(AHint : TPasMemberHint; AHints : TPasMemberHints);
     Property Resolver : TStreamResolver Read FResolver;
     Property Scanner : TPascalScanner Read FScanner;
@@ -148,7 +152,8 @@ begin
   Result:=Module as TPasLibrary;
 end;
 
-procedure TTestParser.SetUp;
+procedure TTestParser.SetupParser;
+
 begin
   FResolver:=TStreamResolver.Create;
   FResolver.OwnsStreams:=True;
@@ -163,7 +168,8 @@ begin
   FIsUnit:=False;
 end;
 
-procedure TTestParser.TearDown;
+procedure TTestParser.CleanupParser;
+
 begin
   if Not Assigned(FModule) then
     FreeAndNil(FDeclarations)
@@ -181,6 +187,25 @@ begin
   FreeAndNil(FResolver);
 end;
 
+procedure TTestParser.ResetParser;
+
+begin
+  CleanupParser;
+  SetupParser;
+end;
+
+procedure TTestParser.SetUp;
+begin
+  Inherited;
+  SetupParser;
+end;
+
+procedure TTestParser.TearDown;
+begin
+  CleanupParser;
+  Inherited;
+end;
+
 procedure TTestParser.StartUnit(AUnitName: String);
 begin
   FIsUnit:=True;
@@ -492,6 +517,13 @@ begin
                    GetEnumName(TypeInfo(TProcedureMessageType),Ord(AActual)));
 end;
 
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TOperatorType);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TOperatorType),Ord(AExpected)),
+                   GetEnumName(TypeInfo(TOperatorType),Ord(AExpected)));
+end;
+
 procedure TTestParser.HaveHint(AHint: TPasMemberHint; AHints: TPasMemberHints);
 begin
   If not (AHint in AHints) then

+ 151 - 87
packages/fcl-passrc/tests/tcprocfunc.pas

@@ -17,6 +17,7 @@ type
     FFunc: TPasFunction;
     FHint: String;
     FProc: TPasProcedure;
+    FOperator:TPasOperator;
     procedure AddDeclaration(const ASource: string; const AHint: String='');
     procedure AssertArg(ProcType: TPasProcedureType; AIndex: Integer;
       AName: String; AAccess: TArgumentAccess; const TypeName: String;
@@ -33,6 +34,7 @@ type
     function ParseProcedure(const ASource: string; const AHint: String=''): TPasProcedure;
     Procedure ParseFunction;
     function ParseFunction(const ASource : String; AResult: string = ''; const AHint: String=''; CC : TCallingConvention = ccDefault): TPasProcedure;
+    Procedure ParseOperator;
   protected
     procedure SetUp; override;
     procedure TearDown; override;
@@ -156,6 +158,8 @@ type
     Procedure TestFunctionCdeclExternalLibNameName;
     Procedure TestProcedureCdeclExternalName;
     Procedure TestFunctionCdeclExternalName;
+    Procedure TestOperatorTokens;
+    procedure TestOperatorNames;
   end;
 
 implementation
@@ -199,7 +203,7 @@ begin
     AssertComment;
 end;
 
-Procedure TTestProcedureFunction.ParseProcedure;
+procedure TTestProcedureFunction.ParseProcedure;
 
 begin
   //  Writeln(source.text);
@@ -230,7 +234,19 @@ begin
   AssertEquals('Correct function result type name',AResult,FuncType.ResultEl.ResultType.Name);
 end;
 
-Procedure TTestProcedureFunction.ParseFunction;
+procedure TTestProcedureFunction.ParseOperator;
+begin
+  //  Writeln(source.text);
+  ParseDeclarations;
+  AssertEquals('One operator definition',1,Declarations.Functions.Count);
+  AssertEquals('First declaration is function declaration.',TPasOperator,TObject(Declarations.Functions[0]).ClassType);
+  FOperator:=TPasOperator(Declarations.Functions[0]);
+  Definition:=FOperator;
+  if (Hint<>'') then
+    CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
+end;
+
+procedure TTestProcedureFunction.ParseFunction;
 begin
   //  Writeln(source.text);
   ParseDeclarations;
@@ -367,13 +383,13 @@ begin
   TestEmptyProcedure;
 end;
 
-Procedure TTestProcedureFunction.TestEmptyFunction;
+procedure TTestProcedureFunction.TestEmptyFunction;
 begin
   ParseFunction('');
   AssertFunc([],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestEmptyFunctionComment;
+procedure TTestProcedureFunction.TestEmptyFunctionComment;
 begin
   AddComment:=True;
   TestEmptyProcedure;
@@ -385,7 +401,7 @@ begin
   AssertProc([],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestEmptyFunctionDeprecated;
+procedure TTestProcedureFunction.TestEmptyFunctionDeprecated;
 begin
   ParseFunction('','deprecated');
   AssertFunc([],ccDefault,0);
@@ -397,7 +413,7 @@ begin
   AssertProc([],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestEmptyFunctionPlatform;
+procedure TTestProcedureFunction.TestEmptyFunctionPlatform;
 begin
   ParseFunction('','platform');
   AssertFunc([],ccDefault,0);
@@ -409,7 +425,7 @@ begin
   AssertProc([],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestEmptyFunctionExperimental;
+procedure TTestProcedureFunction.TestEmptyFunctionExperimental;
 begin
   ParseFunction('','experimental');
   AssertFunc([],ccDefault,0);
@@ -421,7 +437,7 @@ begin
   AssertProc([],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestEmptyFunctionUnimplemented;
+procedure TTestProcedureFunction.TestEmptyFunctionUnimplemented;
 begin
   ParseFunction('','unimplemented');
   AssertFunc([],ccDefault,0);
@@ -437,7 +453,7 @@ begin
   AssertArg(ProcType,0,'B',argDefault,'Integer','');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionOneArg;
+procedure TTestProcedureFunction.TestFunctionOneArg;
 begin
   ParseFunction('(B : Integer)');
   AssertFunc([],ccDefault,1);
@@ -451,7 +467,7 @@ begin
   AssertArg(ProcType,0,'B',argVar,'Integer','');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionOneVarArg;
+procedure TTestProcedureFunction.TestFunctionOneVarArg;
 begin
   ParseFunction('(Var B : Integer)');
   AssertFunc([],ccDefault,1);
@@ -465,7 +481,7 @@ begin
   AssertArg(ProcType,0,'B',argConst,'Integer','');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionOneConstArg;
+procedure TTestProcedureFunction.TestFunctionOneConstArg;
 begin
   ParseFunction('(Const B : Integer)');
   AssertFunc([],ccDefault,1);
@@ -479,7 +495,7 @@ begin
   AssertArg(ProcType,0,'B',argOut,'Integer','');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionOneOutArg;
+procedure TTestProcedureFunction.TestFunctionOneOutArg;
 begin
   ParseFunction('(Out B : Integer)');
   AssertFunc([],ccDefault,1);
@@ -493,7 +509,7 @@ begin
   AssertArg(ProcType,0,'B',argConstRef,'Integer','');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionOneConstRefArg;
+procedure TTestProcedureFunction.TestFunctionOneConstRefArg;
 begin
   ParseFunction('(ConstRef B : Integer)');
   AssertFunc([],ccDefault,1);
@@ -508,7 +524,7 @@ begin
   AssertArg(ProcType,1,'C',argDefault,'Integer','');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionTwoArgs;
+procedure TTestProcedureFunction.TestFunctionTwoArgs;
 begin
   ParseFunction('(B,C : Integer)');
   AssertFunc([],ccDefault,2);
@@ -524,7 +540,7 @@ begin
   AssertArg(ProcType,1,'C',argDefault,'Integer','');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionTwoArgsSeparate;
+procedure TTestProcedureFunction.TestFunctionTwoArgsSeparate;
 begin
   ParseFunction('(B : Integer;C : Integer)');
   AssertFunc([],ccDefault,2);
@@ -539,7 +555,7 @@ begin
   AssertArg(ProcType,0,'B',argDefault,'Integer','1');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionOneArgDefault;
+procedure TTestProcedureFunction.TestFunctionOneArgDefault;
 begin
   ParseFunction('(B : Integer = 1)');
   AssertFunc([],ccDefault,1);
@@ -553,7 +569,7 @@ begin
   AssertArg(ProcType,0,'B',argDefault,'MySet','[1, 2]');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionOneArgDefaultSet;
+procedure TTestProcedureFunction.TestFunctionOneArgDefaultSet;
 begin
   ParseFunction('(B : MySet = [1,2])');
   AssertFunc([],ccDefault,1);
@@ -567,7 +583,7 @@ begin
   AssertArg(ProcType,0,'B',argDefault,'Integer','1 + 2');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionOneArgDefaultExpr;
+procedure TTestProcedureFunction.TestFunctionOneArgDefaultExpr;
 begin
   ParseFunction('(B : Integer = 1 + 2)');
   AssertFunc([],ccDefault,1);
@@ -582,7 +598,7 @@ begin
   AssertArg(ProcType,1,'C',argDefault,'Integer','2');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionTwoArgsDefault;
+procedure TTestProcedureFunction.TestFunctionTwoArgsDefault;
 begin
   ParseFunction('(B : Integer = 1; C : Integer = 2)');
   AssertFunc([],ccDefault,2);
@@ -597,7 +613,7 @@ begin
   AssertArg(ProcType,0,'B',argVar,'','');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionOneUntypedVarArg;
+procedure TTestProcedureFunction.TestFunctionOneUntypedVarArg;
 begin
   ParseFunction('(Var B)');
   AssertFunc([],ccDefault,1);
@@ -612,7 +628,7 @@ begin
   AssertArg(ProcType,1,'C',argVar,'','');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionTwoUntypedVarArgs;
+procedure TTestProcedureFunction.TestFunctionTwoUntypedVarArgs;
 begin
   ParseFunction('(Var B; Var C)');
   AssertFunc([],ccDefault,2);
@@ -627,7 +643,7 @@ begin
   AssertArg(ProcType,0,'B',argConst,'','');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionOneUntypedConstArg;
+procedure TTestProcedureFunction.TestFunctionOneUntypedConstArg;
 begin
   ParseFunction('(Const B)');
   AssertFunc([],ccDefault,1);
@@ -642,7 +658,7 @@ begin
   AssertArg(ProcType,1,'C',argConst,'','');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionTwoUntypedConstArgs;
+procedure TTestProcedureFunction.TestFunctionTwoUntypedConstArgs;
 begin
   ParseFunction('(Const B; Const C)');
   AssertFunc([],ccDefault,2);
@@ -657,7 +673,7 @@ begin
   AssertArrayArg(ProcType,0,'B',argDefault,'Integer');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionOpenArrayArg;
+procedure TTestProcedureFunction.TestFunctionOpenArrayArg;
 begin
   ParseFunction('(B : Array of Integer)');
   AssertFunc([],ccDefault,1);
@@ -672,7 +688,7 @@ begin
   AssertArrayArg(ProcType,1,'C',argDefault,'Integer');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionTwoOpenArrayArgs;
+procedure TTestProcedureFunction.TestFunctionTwoOpenArrayArgs;
 begin
   ParseFunction('(B : Array of Integer;C : Array of Integer)');
   AssertFunc([],ccDefault,2);
@@ -687,7 +703,7 @@ begin
   AssertArrayArg(ProcType,0,'B',argConst,'Integer');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionConstOpenArrayArg;
+procedure TTestProcedureFunction.TestFunctionConstOpenArrayArg;
 begin
   ParseFunction('(Const B : Array of Integer)');
   AssertFunc([],ccDefault,1);
@@ -701,7 +717,7 @@ begin
   AssertArrayArg(ProcType,0,'B',argVar,'Integer');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionVarOpenArrayArg;
+procedure TTestProcedureFunction.TestFunctionVarOpenArrayArg;
 begin
   ParseFunction('(Var B : Array of Integer)');
   AssertFunc([],ccDefault,1);
@@ -715,7 +731,7 @@ begin
   AssertArrayArg(ProcType,0,'B',argDefault,'');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionArrayOfConstArg;
+procedure TTestProcedureFunction.TestFunctionArrayOfConstArg;
 begin
   ParseFunction('(B : Array of Const)');
   AssertFunc([],ccDefault,1);
@@ -729,100 +745,100 @@ begin
   AssertArrayArg(ProcType,0,'B',argConst,'');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionConstArrayOfConstArg;
+procedure TTestProcedureFunction.TestFunctionConstArrayOfConstArg;
 begin
   ParseFunction('(Const B : Array of Const)');
   AssertFunc([],ccDefault,1);
   AssertArrayArg(FuncType,0,'B',argConst,'');
 end;
 
-Procedure TTestProcedureFunction.TestProcedureCdecl;
+procedure TTestProcedureFunction.TestProcedureCdecl;
 begin
   ParseProcedure('; cdecl');
   AssertProc([],ccCdecl,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionCdecl;
+procedure TTestProcedureFunction.TestFunctionCdecl;
 begin
   ParseFunction('','','',ccCdecl);
   AssertFunc([],ccCdecl,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureCdeclDeprecated;
+procedure TTestProcedureFunction.TestProcedureCdeclDeprecated;
 begin
   ParseProcedure('; cdecl;','deprecated');
   AssertProc([],ccCdecl,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionCdeclDeprecated;
+procedure TTestProcedureFunction.TestFunctionCdeclDeprecated;
 begin
   ParseFunction('','','deprecated',ccCdecl);
   AssertFunc([],ccCdecl,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureSafeCall;
+procedure TTestProcedureFunction.TestProcedureSafeCall;
 begin
   ParseProcedure('; safecall;','');
   AssertProc([],ccSafeCall,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionSafeCall;
+procedure TTestProcedureFunction.TestFunctionSafeCall;
 begin
   ParseFunction('','','',ccSafecall);
   AssertFunc([],ccSafecall,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedurePascal;
+procedure TTestProcedureFunction.TestProcedurePascal;
 begin
   ParseProcedure('; pascal;','');
   AssertProc([],ccPascal,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionPascal;
+procedure TTestProcedureFunction.TestFunctionPascal;
 begin
   ParseFunction('','','',ccPascal);
   AssertFunc([],ccPascal,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureStdCall;
+procedure TTestProcedureFunction.TestProcedureStdCall;
 begin
   ParseProcedure('; stdcall;','');
   AssertProc([],ccstdcall,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionStdCall;
+procedure TTestProcedureFunction.TestFunctionStdCall;
 begin
   ParseFunction('','','',ccStdCall);
   AssertFunc([],ccStdCall,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureOldFPCCall;
+procedure TTestProcedureFunction.TestProcedureOldFPCCall;
 begin
   ParseProcedure('; oldfpccall;','');
   AssertProc([],ccoldfpccall,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionOldFPCCall;
+procedure TTestProcedureFunction.TestFunctionOldFPCCall;
 begin
   ParseFunction('','','',ccOldFPCCall);
   AssertFunc([],ccOldFPCCall,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedurePublic;
+procedure TTestProcedureFunction.TestProcedurePublic;
 begin
   ParseProcedure('; public name ''myfunc'';','');
   AssertProc([pmPublic],ccDefault,0);
   AssertExpression('Public name',Proc.PublicName,pekString,'''myfunc''');
 end;
 
-Procedure TTestProcedureFunction.TestProcedurePublicIdent;
+procedure TTestProcedureFunction.TestProcedurePublicIdent;
 begin
   ParseProcedure('; public name exportname;','');
   AssertProc([pmPublic],ccDefault,0);
   AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionPublic;
+procedure TTestProcedureFunction.TestFunctionPublic;
 begin
   AddDeclaration('function A : Integer; public name exportname');
   ParseFunction;
@@ -830,14 +846,14 @@ begin
   AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
 end;
 
-Procedure TTestProcedureFunction.TestProcedureCdeclPublic;
+procedure TTestProcedureFunction.TestProcedureCdeclPublic;
 begin
   ParseProcedure('; cdecl; public name exportname;','');
   AssertProc([pmPublic],ccCDecl,0);
   AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionCdeclPublic;
+procedure TTestProcedureFunction.TestFunctionCdeclPublic;
 begin
   AddDeclaration('function A : Integer; cdecl; public name exportname');
   ParseFunction;
@@ -845,58 +861,58 @@ begin
   AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
 end;
 
-Procedure TTestProcedureFunction.TestProcedureOverload;
+procedure TTestProcedureFunction.TestProcedureOverload;
 begin
   ParseProcedure('; overload;','');
   AssertProc([pmOverload],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionOverload;
+procedure TTestProcedureFunction.TestFunctionOverload;
 begin
   AddDeclaration('function A : Integer; overload');
   ParseFunction;
   AssertFunc([pmOverload],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureVarargs;
+procedure TTestProcedureFunction.TestProcedureVarargs;
 begin
   ParseProcedure('; varargs;','');
   AssertProc([pmVarArgs],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionVarArgs;
+procedure TTestProcedureFunction.TestFunctionVarArgs;
 begin
   AddDeclaration('function A : Integer; varargs');
   ParseFunction;
   AssertFunc([pmVarArgs],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureCDeclVarargs;
+procedure TTestProcedureFunction.TestProcedureCDeclVarargs;
 begin
   ParseProcedure(';cdecl; varargs;','');
   AssertProc([pmVarArgs],ccCDecl,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionCDeclVarArgs;
+procedure TTestProcedureFunction.TestFunctionCDeclVarArgs;
 begin
   AddDeclaration('function A : Integer; cdecl; varargs');
   ParseFunction;
   AssertFunc([pmVarArgs],ccCdecl,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureForwardInterface;
+procedure TTestProcedureFunction.TestProcedureForwardInterface;
 begin
   AddDeclaration('procedure A; forward;');
   AssertException(EParserError,@ParseProcedure);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionForwardInterface;
+procedure TTestProcedureFunction.TestFunctionForwardInterface;
 begin
   AddDeclaration('function A : integer; forward;');
   AssertException(EParserError,@ParseFunction);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureForward;
+procedure TTestProcedureFunction.TestProcedureForward;
 begin
   UseImplementation:=True;
   AddDeclaration('procedure A; forward;');
@@ -904,7 +920,7 @@ begin
   AssertProc([pmforward],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionForward;
+procedure TTestProcedureFunction.TestFunctionForward;
 begin
   UseImplementation:=True;
   AddDeclaration('function A : integer; forward;');
@@ -912,7 +928,7 @@ begin
   AssertFunc([pmforward],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureCdeclForward;
+procedure TTestProcedureFunction.TestProcedureCdeclForward;
 begin
   UseImplementation:=True;
   AddDeclaration('procedure A; cdecl; forward;');
@@ -920,7 +936,7 @@ begin
   AssertProc([pmforward],ccCDecl,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionCDeclForward;
+procedure TTestProcedureFunction.TestFunctionCDeclForward;
 begin
   UseImplementation:=True;
   AddDeclaration('function A : integer; cdecl; forward;');
@@ -928,92 +944,92 @@ begin
   AssertFunc([pmforward],ccCDecl,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureCompilerProc;
+procedure TTestProcedureFunction.TestProcedureCompilerProc;
 begin
   ParseProcedure(';compilerproc;','');
   AssertProc([pmCompilerProc],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionCompilerProc;
+procedure TTestProcedureFunction.TestFunctionCompilerProc;
 begin
   AddDeclaration('function A : Integer; compilerproc');
   ParseFunction;
   AssertFunc([pmCompilerProc],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureCDeclCompilerProc;
+procedure TTestProcedureFunction.TestProcedureCDeclCompilerProc;
 begin
   ParseProcedure(';cdecl;compilerproc;','');
   AssertProc([pmCompilerProc],ccCDecl,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionCDeclCompilerProc;
+procedure TTestProcedureFunction.TestFunctionCDeclCompilerProc;
 begin
   AddDeclaration('function A : Integer; cdecl; compilerproc');
   ParseFunction;
   AssertFunc([pmCompilerProc],ccCDecl,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureAssembler;
+procedure TTestProcedureFunction.TestProcedureAssembler;
 begin
   ParseProcedure(';assembler;','');
   AssertProc([pmAssembler],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionAssembler;
+procedure TTestProcedureFunction.TestFunctionAssembler;
 begin
   AddDeclaration('function A : Integer; assembler');
   ParseFunction;
   AssertFunc([pmAssembler],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureCDeclAssembler;
+procedure TTestProcedureFunction.TestProcedureCDeclAssembler;
 begin
   ParseProcedure(';cdecl;assembler;','');
   AssertProc([pmAssembler],ccCDecl,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionCDeclAssembler;
+procedure TTestProcedureFunction.TestFunctionCDeclAssembler;
 begin
   AddDeclaration('function A : Integer; cdecl; assembler');
   ParseFunction;
   AssertFunc([pmAssembler],ccCDecl,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureExport;
+procedure TTestProcedureFunction.TestProcedureExport;
 begin
   ParseProcedure(';export;','');
   AssertProc([pmExport],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionExport;
+procedure TTestProcedureFunction.TestFunctionExport;
 begin
   AddDeclaration('function A : Integer; export');
   ParseFunction;
   AssertFunc([pmExport],ccDefault,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureCDeclExport;
+procedure TTestProcedureFunction.TestProcedureCDeclExport;
 begin
   ParseProcedure('cdecl;export;','');
   AssertProc([pmExport],ccCDecl,0);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionCDeclExport;
+procedure TTestProcedureFunction.TestFunctionCDeclExport;
 begin
   AddDeclaration('function A : Integer; cdecl; export');
   ParseFunction;
   AssertFunc([pmExport],ccCDecl,0);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureExternal;
+procedure TTestProcedureFunction.TestProcedureExternal;
 begin
   ParseProcedure(';external','');
   AssertProc([pmExternal],ccDefault,0);
   AssertNull('No Library name expression',Proc.LibraryExpr);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionExternal;
+procedure TTestProcedureFunction.TestFunctionExternal;
 begin
   AddDeclaration('function A : Integer; external');
   ParseFunction;
@@ -1021,14 +1037,14 @@ begin
   AssertNull('No Library name expression',Func.LibraryExpr);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureExternalLibName;
+procedure TTestProcedureFunction.TestProcedureExternalLibName;
 begin
   ParseProcedure(';external ''libname''','');
   AssertProc([pmExternal],ccDefault,0);
   AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionExternalLibName;
+procedure TTestProcedureFunction.TestFunctionExternalLibName;
 begin
   AddDeclaration('function A : Integer; external ''libname''');
   ParseFunction;
@@ -1036,7 +1052,7 @@ begin
   AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
 end;
 
-Procedure TTestProcedureFunction.TestProcedureExternalLibNameName;
+procedure TTestProcedureFunction.TestProcedureExternalLibNameName;
 begin
   ParseProcedure(';external ''libname'' name ''symbolname''','');
   AssertProc([pmExternal],ccDefault,0);
@@ -1044,7 +1060,7 @@ begin
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionExternalLibNameName;
+procedure TTestProcedureFunction.TestFunctionExternalLibNameName;
 begin
   AddDeclaration('function A : Integer; external ''libname'' name ''symbolname''');
   ParseFunction;
@@ -1053,7 +1069,7 @@ begin
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
-Procedure TTestProcedureFunction.TestProcedureExternalName;
+procedure TTestProcedureFunction.TestProcedureExternalName;
 begin
   ParseProcedure(';external name ''symbolname''','');
   AssertProc([pmExternal],ccDefault,0);
@@ -1061,7 +1077,7 @@ begin
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionExternalName;
+procedure TTestProcedureFunction.TestFunctionExternalName;
 begin
   AddDeclaration('function A : Integer; external name ''symbolname''');
   ParseFunction;
@@ -1070,14 +1086,14 @@ begin
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
-Procedure TTestProcedureFunction.TestProcedureCdeclExternal;
+procedure TTestProcedureFunction.TestProcedureCdeclExternal;
 begin
   ParseProcedure('; cdecl; external','');
   AssertProc([pmExternal],ccCdecl,0);
   AssertNull('No Library name expression',Proc.LibraryExpr);
 end;
 
-Procedure TTestProcedureFunction.TestFunctionCdeclExternal;
+procedure TTestProcedureFunction.TestFunctionCdeclExternal;
 begin
   AddDeclaration('function A : Integer; cdecl; external');
   ParseFunction;
@@ -1085,14 +1101,14 @@ begin
   AssertNull('No Library name expression',Func.LibraryExpr);
 end;
 
-Procedure TTestProcedureFunction.TestProcedureCdeclExternalLibName;
+procedure TTestProcedureFunction.TestProcedureCdeclExternalLibName;
 begin
   ParseProcedure('; cdecl; external ''libname''','');
   AssertProc([pmExternal],ccCdecl,0);
   AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionCdeclExternalLibName;
+procedure TTestProcedureFunction.TestFunctionCdeclExternalLibName;
 begin
   AddDeclaration('function A : Integer; cdecl; external ''libname''');
   ParseFunction;
@@ -1100,7 +1116,7 @@ begin
   AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
 end;
 
-Procedure TTestProcedureFunction.TestProcedureCdeclExternalLibNameName;
+procedure TTestProcedureFunction.TestProcedureCdeclExternalLibNameName;
 begin
   ParseProcedure('; cdecl; external ''libname'' name ''symbolname''','');
   AssertProc([pmExternal],ccCdecl,0);
@@ -1108,7 +1124,7 @@ begin
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionCdeclExternalLibNameName;
+procedure TTestProcedureFunction.TestFunctionCdeclExternalLibNameName;
 begin
   AddDeclaration('function A : Integer; cdecl; external ''libname'' name ''symbolname''');
   ParseFunction;
@@ -1117,7 +1133,7 @@ begin
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
-Procedure TTestProcedureFunction.TestProcedureCdeclExternalName;
+procedure TTestProcedureFunction.TestProcedureCdeclExternalName;
 begin
   ParseProcedure('; cdecl; external name ''symbolname''','');
   AssertProc([pmExternal],ccCdecl,0);
@@ -1125,7 +1141,7 @@ begin
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
-Procedure TTestProcedureFunction.TestFunctionCdeclExternalName;
+procedure TTestProcedureFunction.TestFunctionCdeclExternalName;
 begin
   AddDeclaration('function A : Integer; cdecl; external name ''symbolname''');
   ParseFunction;
@@ -1134,6 +1150,54 @@ begin
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
+procedure TTestProcedureFunction.TestOperatorTokens;
+
+Var
+  t : TOperatorType;
+
+begin
+  For t:=otMul to High(TOperatorType) do
+    // No way to distinguish between logical/bitwise or/and/Xor
+    if not (t in [otBitwiseOr,otBitwiseAnd,otBitwiseXor]) then
+      begin
+      ResetParser;
+      if t in UnaryOperators then
+        AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorTokens[t]]))
+      else
+        AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorTokens[t]]));
+      ParseOperator;
+      AssertEquals('Token based',Not (T in [otInc,otDec]),FOperator.TokenBased);
+      AssertEquals('Correct operator type',T,FOperator.OperatorType);
+      if t in UnaryOperators then
+        AssertEquals('Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
+      else
+        AssertEquals('Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
+      end;
+end;
+
+procedure TTestProcedureFunction.TestOperatorNames;
+
+Var
+  t : TOperatorType;
+
+begin
+  For t:=Succ(otUnknown) to High(TOperatorType) do
+      begin
+      ResetParser;
+      if t in UnaryOperators then
+        AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorNames[t]]))
+      else
+        AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorNames[t]]));
+      ParseOperator;
+      AssertEquals('Token based',False,FOperator.TokenBased);
+      AssertEquals('Correct operator type',T,FOperator.OperatorType);
+      if t in UnaryOperators then
+        AssertEquals('Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
+      else
+        AssertEquals('Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
+      end;
+end;
+
 procedure TTestProcedureFunction.SetUp;
 begin
    Inherited;
@@ -1144,7 +1208,7 @@ begin
    Inherited;
 end;
 
-Procedure TTestProcedureFunction.AssertComment;
+procedure TTestProcedureFunction.AssertComment;
 begin
   AssertEquals('Correct comment',' A comment'+sLineBreak,FProc.DocComment);
 end;

+ 52 - 7
packages/fcl-passrc/tests/tctypeparser.pas

@@ -169,7 +169,8 @@ type
     procedure AssertVariantSelector(AName, AType: string);
     procedure AssertField1(Hints: TPasMemberHints);
     procedure AssertField2(Hints: TPasMemberHints);
-    procedure AssertMethod2(Hints: TPasMemberHints);
+    procedure AssertMethod2(Hints: TPasMemberHints; isClass : Boolean = False);
+    procedure AssertOperatorMethod2(Hints: TPasMemberHints; isClass : Boolean = False);
     procedure AssertVariant1(Hints: TPasMemberHints);
     procedure AssertVariant1(Hints: TPasMemberHints; VariantLabels : Array of string);
     procedure AssertVariant2(Hints: TPasMemberHints);
@@ -245,6 +246,7 @@ type
     Procedure TestFieldAnd2Methods;
     Procedure TestFieldAndProperty;
     Procedure TestFieldAndClassMethod;
+    Procedure TestFieldAndClassOperator;
     Procedure TestNested;
     Procedure TestNestedDeprecated;
     Procedure TestNestedPlatform;
@@ -731,15 +733,20 @@ end;
 Function TTestProcedureTypeParser.ParseType(ASource: String;
   CC: TCallingConvention; ATypeClass: TClass; Const AHint: String
   ): TPasProcedureType;
+
+Var
+  CCS : String;
+
 begin
   if CC=ccdefault then
     Result:=TPasProcedureType(ParseType(ASource,ATypeClass,AHint))
   else
     begin
+    CCS:=cCallingConventions[CC];
     if (AHint<>'') then
-      Result:=TPasProcedureType(ParseType(ASource+';' +cCallingConventions[CC]+';',ATypeClass,AHint))
+      Result:=TPasProcedureType(ParseType(ASource+';' +CCS+';',ATypeClass,AHint))
     else
-      Result:=TPasProcedureType(ParseType(ASource+';' +cCallingConventions[CC],ATypeClass,AHint));
+      Result:=TPasProcedureType(ParseType(ASource+';' +CCS,ATypeClass,AHint));
     end;
   FProc:=Result;
   AssertEquals('Correct calling convention for procedural type',cc,Result.CallingConvention);
@@ -1468,18 +1475,37 @@ begin
   AssertTrue('Field 2 hints match',Field2.Hints=Hints)
 end;
 
-procedure TTestRecordTypeParser.AssertMethod2(Hints: TPasMemberHints);
+procedure TTestRecordTypeParser.AssertMethod2(Hints: TPasMemberHints; isClass : Boolean = False);
 
 Var
   P : TPasProcedure;
 
 begin
-  AssertEquals('Member 2 type',TPasProcedure,TObject(TheRecord.Members[1]).ClassType);
+  if IsClass then
+    AssertEquals('Member 2 type',TPasClassProcedure,TObject(TheRecord.Members[1]).ClassType)
+  else
+    AssertEquals('Member 2 type',TPasProcedure,TObject(TheRecord.Members[1]).ClassType);
   P:=TPasProcedure(TheRecord.Members[1]);
   AssertEquals('Method name','dosomething2',P.Name);
   AssertTrue('Method hints match',P.Hints=Hints)
 end;
 
+procedure TTestRecordTypeParser.AssertOperatorMethod2(Hints: TPasMemberHints;
+  isClass: Boolean);
+Var
+  P : TPasOperator;
+
+begin
+  if IsClass then
+    AssertEquals('Member 2 type',TPasClassOperator,TObject(TheRecord.Members[1]).ClassType)
+  else
+    AssertEquals('Member 2 type',TPasOperator,TObject(TheRecord.Members[1]).ClassType);
+  P:=TPasOperator(TheRecord.Members[1]);
+  AssertEquals('Method name','assign(ta,Cardinal):Boolean',P.Name);
+
+  AssertTrue('Method hints match',P.Hints=Hints)
+end;
+
 procedure TTestRecordTypeParser.AssertOneIntegerField(Hints : TPasMemberHints);
 
 begin
@@ -1883,11 +1909,30 @@ Var
   P : TPasFunction;
 
 begin
+  Parser.Options:=[po_delphi];
   TestFields(['x : integer;','class procedure dosomething2;','function dosomething3 : Integer;'],'',False);
   AssertEquals('Member count',3,TheRecord.Members.Count);
   AssertField1([]);
-  AssertMethod2([]);
-  AssertEquals('Class procedure',TPasProcedure,TObject(TheRecord.Members[1]).ClassType);
+  AssertMethod2([],True);
+  AssertEquals('Class procedure',TPasClassProcedure,TObject(TheRecord.Members[1]).ClassType);
+  AssertEquals('Member 3 type',TPasFunction,TObject(TheRecord.Members[2]).ClassType);
+  P:=TPasFunction(TheRecord.Members[2]);
+  AssertEquals('Method 2 name','dosomething3',P.Name);
+  AssertTrue('Method 2 hints match',[]=P.Hints);
+  // Standard type
+  AssertEquals('Method 2 result type','Integer', P.FuncType.ResultEl.ResultType.Name);
+end;
+
+procedure TTestRecordTypeParser.TestFieldAndClassOperator;
+
+Var
+  P : TPasFunction;
+
+begin
+  TestFields(['x : integer;','class operator assign(a : ta; b : Cardinal) : boolean;','function dosomething3 : Integer;'],'',False);
+  AssertEquals('Member count',3,TheRecord.Members.Count);
+  AssertField1([]);
+  AssertOperatorMethod2([],True);
   AssertEquals('Member 3 type',TPasFunction,TObject(TheRecord.Members[2]).ClassType);
   P:=TPasFunction(TheRecord.Members[2]);
   AssertEquals('Method 2 name','dosomething3',P.Name);

+ 1 - 7
packages/fcl-passrc/tests/testpassrc.lpi

@@ -30,7 +30,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestStatementParser.TestAsm"/>
+        <CommandLineParams Value="--suite=TTestProcedureFunction.TestOperatorTokens"/>
       </local>
     </RunParams>
     <RequiredPackages Count="1">
@@ -46,22 +46,18 @@
       <Unit1>
         <Filename Value="tcscanner.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcscanner"/>
       </Unit1>
       <Unit2>
         <Filename Value="tctypeparser.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tctypeparser"/>
       </Unit2>
       <Unit3>
         <Filename Value="tcstatements.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcstatements"/>
       </Unit3>
       <Unit4>
         <Filename Value="tcbaseparser.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcbaseparser"/>
       </Unit4>
       <Unit5>
         <Filename Value="tcmoduleparser.pas"/>
@@ -74,7 +70,6 @@
       <Unit7>
         <Filename Value="tcvarparser.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcvarparser"/>
       </Unit7>
       <Unit8>
         <Filename Value="tcclasstype.pas"/>
@@ -83,7 +78,6 @@
       <Unit9>
         <Filename Value="tcexprparser.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcexprparser"/>
       </Unit9>
       <Unit10>
         <Filename Value="tcprocfunc.pas"/>

+ 4 - 0
utils/fpdoc/dglobals.pp

@@ -1514,7 +1514,11 @@ begin
     if AElement.InheritsFrom(TPasUnresolvedTypeRef) then
       Result := FindDocNode(AElement.GetModule, AElement.Name)
     else
+      begin
       Result := RootDocNode.FindChild(AElement.PathName);
+      if (Result=Nil) and (AElement is TPasoperator) then
+        Result:=RootDocNode.FindChild(TPasOperator(AElement).OldName(True));
+      end;
     if (Result=Nil) and
        WarnNoNode and
        (Length(AElement.PathName)>0) and

+ 6 - 1
utils/fpdoc/dw_html.pp

@@ -1855,7 +1855,10 @@ procedure THTMLWriter.AppendProcDecl(CodeEl, TableEl: TDOMElement;
       AppendSym(CodeEl, '.');
       AppendText(CodeEl, AProc.Name);
     end else
-      AppendText(CodeEl, ' ' + AProc.FullName);
+      if (Element is TPasOperator) then
+        AppendText(CodeEl, ' ' + TPasOperator(AProc).GetOperatorDeclaration(True))
+      else
+        AppendText(CodeEl, ' ' + AProc.FullName);
     CodeEl := AppendProcType(CodeEl, TableEl, AProc.ProcType, 0);
     AppendSym(CodeEl, ';');
     AppendProcExt(CodeEl, AProc);
@@ -2571,6 +2574,8 @@ begin
       CreateProcPageBody(TPasProcedureBase(AElement))
     else if AElement.ClassType = TTopicELement then
       CreateTopicPageBody(TTopicElement(AElement))
+    else if AElement.ClassType = TPasProperty then
+      CreateClassMemberPageBody(TPasProperty(AElement))
     else
       writeln('Unknown classtype: ',AElement.classtype.classname);
   end;

+ 10 - 0
utils/fpdoc/gentest.sh

@@ -0,0 +1,10 @@
+if [ -e ./fpdoc ]; then
+  FPDOC=./fpdoc
+fi 
+NEWERDOC=`find bin -newer ./fpdoc -type f | xargs -r ls -t | head -1`
+if [ ! -z "$NEWERDOC" ]; then
+  FPDOC="$NEWERDOC"
+fi 
+echo "Using fpdoc executable $FPDOC"
+echo "Writing output to fpdoctest"
+$FPDOC --package=fpdoc --input='-S2 testunit.pp' --output=fpdoctest --format=html --warn-no-node -v --descr=testunit.xml

+ 25 - 6
utils/fpdoc/makeskel.pp

@@ -1,5 +1,4 @@
 {
-
     FPDoc  -  Free Pascal Documentation Tool
     Copyright (C) 2000 - 2003 by
       Areca Systems GmbH / Sebastian Guenther, [email protected]
@@ -18,9 +17,6 @@
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 }
-
-
-{%RunCommand $MakeExe($(EdFile)) --package=fpvectorial --input=/home/felipe/Programas/fpctrunk/packages/fpvectorial/src/fpvectorial.pas}
 program MakeSkel;
 
 {$mode objfpc}
@@ -350,11 +346,33 @@ end;
 
 Procedure TSkelEngine.DocumentFile(Var F : Text; Const AFileName,ATarget,ACPU : String);
 
+  Procedure ResolveOperators;
+
+  Var
+    E : TPasElement;
+    P : TNodePair;
+    N : TDocNode;
+    I : integer;
+
+  begin
+    For I:=0 to FNodeList.Count-1 do
+      begin
+      P:=TNodePair(FNodeList.Objects[i]);
+      if P.Element.InheritsFrom(TPasOperator) then
+        begin
+        N:=FindDocNode(P.Element);
+        If Assigned(N) then
+          N.IncRefCount;
+        P.FNode:=N;
+        end;
+      end;
+  end;
+
 Var
   Module : TPasModule;
   I : Integer;
   N : TDocNode;
-     
+
 begin
 // wrong because afilename is a cmdline with other options. Straight testing filename is therefore wrong.
 //  if not(FileExists(AFileName)) then
@@ -370,7 +388,8 @@ begin
         N:=FindDocNode(Module);
         If Assigned(N) then
            N.IncRefCount;
-         end;
+        ResolveOperators;
+        end;
       If SortNodes then  
         FNodelist.Sorted:=True;   
       WriteNodes(F,Module,FNodeList);  

+ 1 - 0
utils/fpdoc/mkfpdoc.pp

@@ -210,6 +210,7 @@ begin
     Engine.HideProtected:=Options.HideProtected;
     Engine.HidePrivate:=Not Options.ShowPrivate;
     Engine.OnParseUnit:=@HandleOnParseUnit;
+    Engine.WarnNoNode:=Options.WarnNoNode;
     if Length(Options.Language) > 0 then
       TranslateDocStrings(Options.Language);
     for i := 0 to APackage.Inputs.Count - 1 do

+ 19 - 0
utils/fpdoc/testunit.pp

@@ -45,7 +45,9 @@ Type
   TADeprecatedType = Integer deprecated;
 
   TMethodRecord = Record
+  
   Private
+    Const aconst = 123;
     X22 : Integer;
     Procedure SetX(AValue : Integer);
     Function GetX : Integer;
@@ -56,6 +58,10 @@ Type
     1 : (X2,Y2 : Integer);
     2 : (phi,Omega : Real);
   end;
+  TAExtRecordType        = Record
+    Const X = 100;
+    operator assign(Y : Integer) : TAExtRecordType;
+  end;
                         
 Var
   ASimpleVar : Integer;  
@@ -138,6 +144,9 @@ Type
   Published
     Property AProtectedProp;
   end;
+
+Operator + (A,B : TAnArrayType) : TAnArrayType;
+Operator multiply (A,B : TAnArrayType) : TAnArrayType;
   
 Implementation
 
@@ -305,4 +314,14 @@ Procedure TMEthodRecord.MyMethod;
 begin
 end;
 
+Operator + (A,B : TAnArrayType) : TAnArrayType;
+
+begin
+end;
+
+Operator subtract (A,B : TAnArrayType) : TAnArrayType;
+
+begin
+end;
+
 end.

+ 182 - 0
utils/fpdoc/testunit.xml

@@ -1114,6 +1114,188 @@ Appears in 2.0
 </notes>
 </element>
 
+<element name="add(TAnArrayType,TAnArrayType):TAnArrayType">
+<short>Something short about operator add</short>
+<descr>
+Something long about operator add
+</descr>
+</element>
+
+<element name="operator *(TAnArrayType, TAnArrayType): TAnArrayType">
+<short>Something short about operator -</short>
+<descr>
+Something long about operator -
+</descr>
+</element>
+
+<element name="TAExtRecordType.assign(Integer):TAExtRecordType">
+<short>An operator</short>
+</element>
+
+<element name="TMethodRecord.MyX"/>
+
+<!-- alias type Visibility: default -->
+<element name="TADeprecatedType">
+<short></short>
+<descr>
+</descr>
+<seealso>
+</seealso>
+</element>
+
+<!-- constant Visibility: default -->
+<element name="TMethodRecord.aconst">
+<short></short>
+<descr>
+</descr>
+<seealso>
+</seealso>
+</element>
+
+<!-- variable Visibility: private -->
+<element name="TMethodRecord.X22">
+<short></short>
+<descr>
+</descr>
+<seealso>
+</seealso>
+</element>
+
+<!-- procedure Visibility: private -->
+<element name="TMethodRecord.SetX">
+<short></short>
+<descr>
+</descr>
+<errors>
+</errors>
+<seealso>
+</seealso>
+</element>
+
+<!-- argument Visibility: private -->
+<element name="TMethodRecord.SetX.AValue">
+<short></short>
+</element>
+
+<!-- function Visibility: private -->
+<element name="TMethodRecord.GetX">
+<short></short>
+<descr>
+</descr>
+<errors>
+</errors>
+<seealso>
+</seealso>
+</element>
+
+<!-- function result Visibility: private -->
+<element name="TMethodRecord.GetX.Result">
+<short></short>
+</element>
+
+<!-- variable Visibility: default -->
+<element name="TMethodRecord.X2">
+<short></short>
+<descr>
+</descr>
+<seealso>
+</seealso>
+</element>
+
+<!-- variable Visibility: default -->
+<element name="TMethodRecord.Y2">
+<short></short>
+<descr>
+</descr>
+<seealso>
+</seealso>
+</element>
+
+<!-- variable Visibility: default -->
+<element name="TMethodRecord.phi">
+<short></short>
+<descr>
+</descr>
+<seealso>
+</seealso>
+</element>
+
+<!-- variable Visibility: default -->
+<element name="TMethodRecord.Omega">
+<short></short>
+<descr>
+</descr>
+<seealso>
+</seealso>
+</element>
+
+<!-- constant Visibility: default -->
+<element name="TAExtRecordType.X">
+<short></short>
+<descr>
+</descr>
+<seealso>
+</seealso>
+</element>
+
+<!-- function result Visibility: default -->
+<element name="TAExtRecordType.assign(Integer):TAExtRecordType.Result">
+<short></short>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="TAExtRecordType.assign(Integer):TAExtRecordType.Y">
+<short></short>
+</element>
+
+<!-- variable Visibility: default -->
+<element name="A">
+<short></short>
+<descr>
+</descr>
+<seealso>
+</seealso>
+</element>
+
+<!-- variable Visibility: default -->
+<element name="B">
+<short></short>
+<descr>
+</descr>
+<seealso>
+</seealso>
+</element>
+
+<!-- function result Visibility: default -->
+<element name="add(TAnArrayType,TAnArrayType):TAnArrayType.Result">
+<short></short>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="add(TAnArrayType,TAnArrayType):TAnArrayType.A">
+<short></short>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="add(TAnArrayType,TAnArrayType):TAnArrayType.B">
+<short></short>
+</element>
+
+<!-- function result Visibility: default -->
+<element name="multiply(TAnArrayType,TAnArrayType):TAnArrayType.Result">
+<short></short>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="multiply(TAnArrayType,TAnArrayType):TAnArrayType.A">
+<short></short>
+</element>
+
+<!-- argument Visibility: default -->
+<element name="multiply(TAnArrayType,TAnArrayType):TAnArrayType.B">
+<short></short>
+</element>
+
 </module> <!-- testunit -->
 
 </package>