# revisions: 32727,32728,32751,32751,32752,32756,32771,32794

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

.gitattributes

@@ -2350,6 +2350,7 @@ packages/fcl-fpcunit/src/exampletests/Makefile.fpc svneol=native#text/plain
 packages/fcl-fpcunit/src/exampletests/fpcunittests.pp svneol=native#text/plain
 packages/fcl-fpcunit/src/exampletests/money.pp svneol=native#text/plain
 packages/fcl-fpcunit/src/exampletests/moneytest.pp svneol=native#text/plain
+packages/fcl-fpcunit/src/exampletests/needassert.pp svneol=native#text/plain
 packages/fcl-fpcunit/src/exampletests/testmockobject.pp svneol=native#text/plain
 packages/fcl-fpcunit/src/fpcunit.pp svneol=native#text/plain
 packages/fcl-fpcunit/src/fpcunitreport.pp svneol=native#text/plain

packages/fcl-fpcunit/src/exampletests/needassert.pp

@@ -0,0 +1,38 @@
+program needassert;
+
+uses fpcunit, testregistry, consoletestrunner;
+
+Type
+  TTestNeedAssert = Class(TTestCase) 
+  Published
+    Procedure NeedsToFail;
+    Procedure NeedsToBeOK;
+  end;
+
+Procedure TTestNeedAssert.NeedsToFail;
+
+begin
+  // Do not call assert.
+end;
+
+Procedure TTestNeedAssert.NeedsToBeOK;
+
+begin
+  AssertTrue('Some message',True);
+end;
+
+
+
+Var
+  Application : TTestRunner;
+  
+begin
+  RegisterTest(TTestNeedAssert);
+  TTestCase.CheckAssertCalled:=true;
+  DefaultFormat:=fPlain;
+  DefaultRunAllTests:=True;
+  Application:=TTestRunner.Create(Nil);
+  Application.Initialize;
+  Application.Run;
+  Application.Free;
+end.  

packages/fcl-fpcunit/src/fpcunit.pp

@@ -78,6 +78,8 @@ type
   { TAssert }
 
   TAssert = class(TTest)
+  protected
+    Class var AssertCount : Integer;
   public
     class procedure Fail(const AMessage: string; AErrorAddrs: Pointer = nil);
     class procedure Fail(const AFmt: string; Args : Array of const;  AErrorAddrs: Pointer = nil);
@@ -206,7 +208,10 @@ type
     procedure SetTestName(const Value: string); virtual;
     procedure SetEnableIgnores(Value: boolean); override;
     procedure RunBare; virtual;
+  Public
+    Class Var CheckAssertCalled : Boolean;   
   public
+  
     constructor Create; virtual;
     constructor CreateWith(const ATestName: string; const ATestSuiteName: string); virtual;
     constructor CreateWithName(const AName: string); virtual;
@@ -330,7 +335,8 @@ Resourcestring
   SNoValidInheritance = ' does not inherit from TTestCase';
   SNoValidTests = 'No valid tests found in ';
   SNoException = 'no exception';
-
+  SAssertNotCalled = 'Assert not called during test.';
+  
 implementation
 
 uses
@@ -545,6 +551,7 @@ end;
 
 class procedure TAssert.Fail(const AMessage: string; AErrorAddrs: Pointer);
 begin
+  Inc(AssertCount);
   if AErrorAddrs = nil then
     raise EAssertionFailedError.Create(AMessage) at CallerAddr
   else
@@ -553,6 +560,7 @@ end;
 
 class procedure TAssert.Fail(const AFmt: string; Args: array of const; AErrorAddrs: Pointer = nil);
 begin
+  Inc(AssertCount);
   if AErrorAddrs = nil then
     raise EAssertionFailedError.CreateFmt(AFmt,Args) at CallerAddr
   else    
@@ -574,7 +582,9 @@ begin
   if AErrorAddrs=Nil then
     AErrorAddrs:=CallerAddr;
   if (not ACondition) then
-    Fail(AMessage,AErrorAddrs);
+    Fail(AMessage,AErrorAddrs)
+  else
+    Inc(AssertCount); // Fail will increae AssertCount
 end;
 
 
@@ -1013,10 +1023,13 @@ begin
     RunMethod := TRunMethod(m);
     ExpectException('',Nil,'',0);
     try
+      AssertCount:=0;
       FailMessage:='';
       RunMethod;
       if (FExpectedException<>Nil) then
-        FailMessage:=Format(SExceptionCompare, [FExpectedException.ClassName, SNoException])
+        FailMessage:=Format(SExceptionCompare, [FExpectedException.ClassName, SNoException]);
+      if CheckAssertCalled and (AssertCount=0) then  
+        FailMessage:=SAssertNotCalled;
     except
       On E : Exception do
         begin
@@ -1465,5 +1478,7 @@ begin
     ITestListener(FListeners[i]).EndTestSuite(ATestSuite);
 end;
 
+initialization
+  TTestCase.CheckAssertCalled:=False;
 end.
 

packages/fcl-passrc/src/pparser.pp

@@ -1355,17 +1355,6 @@ begin
       end;
     end;
 
-    if CurToken = tkDotDot then begin
-      NextToken;
-      b:=TBinaryExpr.CreateRange(AParent,x, DoParseExpression(AParent));
-      if not Assigned(b.right) then
-        begin
-        b.free;
-        Exit; // error
-        end;
-      x:=b;
-    end;
-
     Result:=x;
   finally
     if not Assigned(Result) then x.Free;
@@ -1439,11 +1428,16 @@ const
     t       : TToken;
     xright  : TPasExpr;
     xleft   : TPasExpr;
+    bin     : TBinaryExpr;
   begin
     t:=PopOper;
     xright:=PopExp;
     xleft:=PopExp;
-    expstack.Add(TBinaryExpr.Create(AParent,xleft, xright, TokenToExprOp(t)));
+    if t=tkDotDot then
+      bin := TBinaryExpr.CreateRange(AParent,xleft, xright)
+    else
+      bin := TBinaryExpr.Create(AParent,xleft, xright, TokenToExprOp(t));
+    expstack.Add(bin);
   end;
 
 begin

packages/fcl-passrc/tests/tcexprparser.pas

@@ -258,15 +258,18 @@ end;
 procedure TTestExpressions.TestRange;
 
 Var
+  P : TParamsExpr;
   B : TBinaryExpr;
 
 begin
   DeclareVar('boolean','a');
   DeclareVar('byte','b');
-  ParseExpression('b in 0..10');
+  ParseExpression('b in [0..10]');
   AssertBinaryExpr('Simple binary In',eopIn,FLeft,FRight);
   AssertExpression('Left is b',TheLeft,pekIdent,'b');
-  B:=TBinaryExpr(AssertExpression('Right is range',TheRight,pekRange,TBinaryExpr));
+  P:=TParamsExpr(AssertExpression('Right is set',TheRight,pekSet,TParamsExpr));
+  AssertEquals('Number of items',1,Length(P.Params));
+  B:=TBinaryExpr(AssertExpression('First element is range',P.Params[0],pekRange,TBinaryExpr));
   AssertExpression('Left is 0',B.Left,pekNumber,'0');
   AssertExpression('Right is 10',B.Right,pekNumber,'10');
 end;

packages/fcl-passrc/tests/tctypeparser.pas

@@ -142,6 +142,7 @@ type
     Procedure TestSubRangeSet;
     Procedure TestRangeSetDeprecated;
     Procedure TestRangeSetPlatform;
+    Procedure TestNegativeRangeType;
     Procedure TestClassOf;
     Procedure TestClassOfComment;
     Procedure TestClassOfDeprecated;
@@ -2363,8 +2364,8 @@ end;
 
 { TTestTypeParser }
 
-Procedure TTestTypeParser.DoTestAliasType(Const AnAliasType: String;
-  Const AHint: String);
+procedure TTestTypeParser.DoTestAliasType(const AnAliasType: String;
+  const AHint: String);
 begin
   ParseType(AnAliasType,TPasAliasType,AHint);
   AssertEquals('Unresolved type',TPasUnresolvedTypeRef,TPasAliasType(TheType).DestType.ClassType);
@@ -2377,20 +2378,20 @@ begin
   AssertEquals('String type',TPasStringType,TPasAliasType(TheType).DestType.ClassType);
 end;
 
-procedure TTestTypeParser.DoTypeError(Const AMsg,ASource : string);
+procedure TTestTypeParser.DoTypeError(const AMsg, ASource: string);
 
 begin
   FErrorSource:=ASource;
   AssertException(AMsg,EParserError,@DoParseError);
 end;
 
-Procedure TTestTypeParser.DoParseError;
+procedure TTestTypeParser.DoParseError;
 begin
   ParseType(FErrorSource,Nil);
 end;
 
-Procedure TTestTypeParser.DoParsePointer(Const ASource: String;
-  Const AHint: String; ADestType: TClass);
+procedure TTestTypeParser.DoParsePointer(const ASource: String;
+  const AHint: String; ADestType: TClass);
 
 begin
   ParseType('^'+ASource,TPasPointerType,AHint);
@@ -2399,8 +2400,8 @@ begin
   AssertEquals('Destination type '+ADestType.ClassName,ADestType,TPasPointerType(TheType).DestType.ClassType);
 end;
 
-Procedure TTestTypeParser.DoParseArray(Const ASource: String;
-  Const AHint: String; ADestType: TClass);
+procedure TTestTypeParser.DoParseArray(const ASource: String;
+  const AHint: String; ADestType: TClass);
 begin
   ParseType(ASource,TPasArrayType,AHint);
   if ADestType = Nil then
@@ -2408,8 +2409,8 @@ begin
   AssertEquals('Destination type '+ADestType.ClassName,ADestType,TPasArrayType(TheType).ElType.ClassType);
 end;
 
-Procedure TTestTypeParser.DoParseEnumerated(Const ASource: String;
-  Const AHint: String; ACount: integer);
+procedure TTestTypeParser.DoParseEnumerated(const ASource: String;
+  const AHint: String; ACount: integer);
 
 Var
   I : Integer;
@@ -2422,8 +2423,8 @@ begin
     AssertEquals('Enum value typed element '+IntToStr(I),TPasEnumValue,TObject(TPasEnumType(TheType).Values[i]).ClassType);
 end;
 
-Procedure TTestTypeParser.DoTestFileType(Const AType: String;
-  Const AHint: String; ADestType: TClass);
+procedure TTestTypeParser.DoTestFileType(const AType: String;
+  const AHint: String; ADestType: TClass);
 begin
   ParseType('File of '+AType,TPasFileType,AHint);
   AssertNotNull('Have element type',TPasFileType(TheType).ElType);
@@ -2432,23 +2433,23 @@ begin
   AssertEquals('Element type '+ADestType.ClassName,ADestType,TPasFileType(TheType).ElType.ClassType);
 end;
 
-Procedure TTestTypeParser.DoTestRangeType(Const AStart, AStop, AHint: String);
+procedure TTestTypeParser.DoTestRangeType(const AStart, AStop, AHint: String);
 begin
   ParseType(AStart+'..'+AStop,TPasRangeType,AHint);
-  AssertEquals('Range start',AStart,TPasRangeType(TheType).RangeStart);
-  AssertEquals('Range start',AStop,TPasRangeType(TheType).RangeEnd);
+  AssertEquals('Range start',AStart,Stringreplace(TPasRangeType(TheType).RangeStart,' ','',[rfReplaceAll]));
+  AssertEquals('Range start',AStop,Stringreplace(TPasRangeType(TheType).RangeEnd,' ','',[rfReplaceAll]));
 end;
 
-Procedure TTestTypeParser.DoParseSimpleSet(Const ASource: String;
-  Const AHint: String);
+procedure TTestTypeParser.DoParseSimpleSet(const ASource: String;
+  const AHint: String);
 begin
   ParseType('Set of '+ASource,TPasSetType,AHint);
   AssertNotNull('Have enumtype',TPasSetType(TheType).EnumType);
   AssertEquals('Element type ',TPasUnresolvedTypeRef,TPasSetType(TheType).EnumType.ClassType);
 end;
 
-Procedure TTestTypeParser.DoParseComplexSet(Const ASource: String;
-  Const AHint: String);
+procedure TTestTypeParser.DoParseComplexSet(const ASource: String;
+  const AHint: String);
 
 begin
   ParseType('Set of '+ASource,TPasSetType,AHint);
@@ -2465,7 +2466,7 @@ begin
   AssertEquals('Element type ',TPasRangeType,TPasSetType(TheType).EnumType.ClassType);
 end;
 
-Procedure TTestTypeParser.DoTestComplexSet;
+procedure TTestTypeParser.DoTestComplexSet;
 
 Var
   I : integer;
@@ -2483,7 +2484,7 @@ begin
   AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TPasSetType(TheType).EnumType).Values[2]).AssignedValue);
 end;
 
-Procedure TTestTypeParser.DoTestClassOf(Const AHint: string);
+procedure TTestTypeParser.DoTestClassOf(const AHint: string);
 
 begin
   ParseType('Class of TSomeClass',TPasClassOfType,AHint);
@@ -2491,285 +2492,285 @@ begin
   AssertEquals('Element type ',TPasUnresolvedTypeRef,TPasClassOfType(TheType).DestType.ClassType);
 end;
 
-Procedure TTestTypeParser.TestAliasType;
+procedure TTestTypeParser.TestAliasType;
 begin
   DoTestAliasType('othertype','');
   AssertEquals('Unresolved type name ','othertype',TPasUnresolvedTypeRef(TPasAliasType(TheType).DestType).name);
 end;
 
-Procedure TTestTypeParser.TestCrossUnitAliasType;
+procedure TTestTypeParser.TestCrossUnitAliasType;
 begin
   DoTestAliasType('otherunit.othertype','');
 end;
 
-Procedure TTestTypeParser.TestAliasTypeDeprecated;
+procedure TTestTypeParser.TestAliasTypeDeprecated;
 begin
   DoTestALiasType('othertype','deprecated');
 end;
 
-Procedure TTestTypeParser.TestAliasTypePlatform;
+procedure TTestTypeParser.TestAliasTypePlatform;
 begin
   DoTestALiasType('othertype','platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeByte;
+procedure TTestTypeParser.TestSimpleTypeByte;
 begin
   DoTestAliasType('BYTE','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeByteComment;
+procedure TTestTypeParser.TestSimpleTypeByteComment;
 begin
   AddComment:=True;
   DoTestAliasType('BYTE','');
   AssertComment;
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeByteDeprecated;
+procedure TTestTypeParser.TestSimpleTypeByteDeprecated;
 begin
   DoTestAliasType('BYTE','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeBytePlatform;
+procedure TTestTypeParser.TestSimpleTypeBytePlatform;
 begin
   DoTestAliasType('BYTE','platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeBoolean;
+procedure TTestTypeParser.TestSimpleTypeBoolean;
 begin
   DoTestAliasType('BOOLEAN','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeBooleanDeprecated;
+procedure TTestTypeParser.TestSimpleTypeBooleanDeprecated;
 begin
   DoTestAliasType('BOOLEAN','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeBooleanPlatform;
+procedure TTestTypeParser.TestSimpleTypeBooleanPlatform;
 begin
   DoTestAliasType('BOOLEAN','platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeChar;
+procedure TTestTypeParser.TestSimpleTypeChar;
 begin
   DoTestAliasType('CHAR','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeCharDeprecated;
+procedure TTestTypeParser.TestSimpleTypeCharDeprecated;
 begin
   DoTestAliasType('CHAR','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeCharPlatform;
+procedure TTestTypeParser.TestSimpleTypeCharPlatform;
 begin
   DoTestAliasType('CHAR','platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeInteger;
+procedure TTestTypeParser.TestSimpleTypeInteger;
 begin
   DoTestAliasType('INTEGER','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeIntegerDeprecated;
+procedure TTestTypeParser.TestSimpleTypeIntegerDeprecated;
 begin
   DoTestAliasType('INTEGER','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeIntegerPlatform;
+procedure TTestTypeParser.TestSimpleTypeIntegerPlatform;
 begin
   DoTestAliasType('INTEGER','platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeInt64;
+procedure TTestTypeParser.TestSimpleTypeInt64;
 begin
   DoTestAliasType('INT64','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeInt64Deprecated;
+procedure TTestTypeParser.TestSimpleTypeInt64Deprecated;
 begin
   DoTestAliasType('INT64','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeInt64Platform;
+procedure TTestTypeParser.TestSimpleTypeInt64Platform;
 begin
   DoTestAliasType('INT64','platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeLongInt;
+procedure TTestTypeParser.TestSimpleTypeLongInt;
 begin
   DoTestAliasType('LONGINT','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeLongIntDeprecated;
+procedure TTestTypeParser.TestSimpleTypeLongIntDeprecated;
 begin
   DoTestAliasType('LONGINT','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeLongIntPlatform;
+procedure TTestTypeParser.TestSimpleTypeLongIntPlatform;
 begin
   DoTestAliasType('LONGINT','platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeLongWord;
+procedure TTestTypeParser.TestSimpleTypeLongWord;
 begin
   DoTestAliasType('LONGWORD','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeLongWordDeprecated;
+procedure TTestTypeParser.TestSimpleTypeLongWordDeprecated;
 begin
   DoTestAliasType('LONGWORD','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeLongWordPlatform;
+procedure TTestTypeParser.TestSimpleTypeLongWordPlatform;
 begin
   DoTestAliasType('LONGWORD','platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeDouble;
+procedure TTestTypeParser.TestSimpleTypeDouble;
 begin
   DoTestAliasType('Double','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeDoubleDeprecated;
+procedure TTestTypeParser.TestSimpleTypeDoubleDeprecated;
 begin
   DoTestAliasType('Double','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeDoublePlatform;
+procedure TTestTypeParser.TestSimpleTypeDoublePlatform;
 begin
   DoTestAliasType('Double','platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeShortInt;
+procedure TTestTypeParser.TestSimpleTypeShortInt;
 begin
   DoTestAliasType('SHORTINT','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeShortIntDeprecated;
+procedure TTestTypeParser.TestSimpleTypeShortIntDeprecated;
 begin
   DoTestAliasType('SHORTINT','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeShortIntPlatform;
+procedure TTestTypeParser.TestSimpleTypeShortIntPlatform;
 begin
   DoTestAliasType('SHORTINT','platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeSmallInt;
+procedure TTestTypeParser.TestSimpleTypeSmallInt;
 begin
   DoTestAliasType('SMALLINT','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeSmallIntDeprecated;
+procedure TTestTypeParser.TestSimpleTypeSmallIntDeprecated;
 begin
   DoTestAliasType('SMALLINT','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeSmallIntPlatform;
+procedure TTestTypeParser.TestSimpleTypeSmallIntPlatform;
 begin
   DoTestAliasType('SMALLINT','platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeString;
+procedure TTestTypeParser.TestSimpleTypeString;
 begin
   DoTestAliasType('STRING','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeStringDeprecated;
+procedure TTestTypeParser.TestSimpleTypeStringDeprecated;
 begin
   DoTestAliasType('STRING','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeStringPlatform;
+procedure TTestTypeParser.TestSimpleTypeStringPlatform;
 begin
   DoTestAliasType('STRING','platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeStringSize;
+procedure TTestTypeParser.TestSimpleTypeStringSize;
 begin
   DoTestStringType('String[10]','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeStringSizeIncomplete;
+procedure TTestTypeParser.TestSimpleTypeStringSizeIncomplete;
 begin
   DoTypeError('Incomplete string: missing ]','string[10');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeStringSizeWrong;
+procedure TTestTypeParser.TestSimpleTypeStringSizeWrong;
 begin
   DoTypeError('Incomplete string, ) instead of ]','string[10)');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeStringSizeDeprecated;
+procedure TTestTypeParser.TestSimpleTypeStringSizeDeprecated;
 begin
   DoTestStringType('String[10]','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeStringSizePlatform;
+procedure TTestTypeParser.TestSimpleTypeStringSizePlatform;
 begin
   DoTestStringType('String[10]','Platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeWord;
+procedure TTestTypeParser.TestSimpleTypeWord;
 BEGIN
   DoTestAliasType('WORD','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeWordDeprecated;
+procedure TTestTypeParser.TestSimpleTypeWordDeprecated;
 begin
   DoTestAliasType('WORD','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeWordPlatform;
+procedure TTestTypeParser.TestSimpleTypeWordPlatform;
 begin
   DoTestAliasType('WORD','platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeQWord;
+procedure TTestTypeParser.TestSimpleTypeQWord;
 BEGIN
   DoTestAliasType('QWORD','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeQWordDeprecated;
+procedure TTestTypeParser.TestSimpleTypeQWordDeprecated;
 begin
   DoTestAliasType('QWORD','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeQWordPlatform;
+procedure TTestTypeParser.TestSimpleTypeQWordPlatform;
 begin
   DoTestAliasType('QWORD','platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeCardinal;
+procedure TTestTypeParser.TestSimpleTypeCardinal;
 begin
   DoTestAliasType('CARDINAL','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeCardinalDeprecated;
+procedure TTestTypeParser.TestSimpleTypeCardinalDeprecated;
 begin
   DoTestAliasType('CARDINAL','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeCardinalPlatform;
+procedure TTestTypeParser.TestSimpleTypeCardinalPlatform;
 begin
   DoTestAliasType('CARDINAL','platform');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeWideChar;
+procedure TTestTypeParser.TestSimpleTypeWideChar;
 begin
   DoTestAliasType('WIDECHAR','');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeWideCharDeprecated;
+procedure TTestTypeParser.TestSimpleTypeWideCharDeprecated;
 begin
   DoTestAliasType('WIDECHAR','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleTypeWideCharPlatform;
+procedure TTestTypeParser.TestSimpleTypeWideCharPlatform;
 begin
   DoTestAliasType('WIDECHAR','platform');
 end;
 
-Procedure TTestTypeParser.TestPointerSimple;
+procedure TTestTypeParser.TestPointerSimple;
 begin
   DoParsePointer('integer','');
 end;
@@ -2784,13 +2785,13 @@ begin
   DoParsePointer('integer','platform');
 end;
 
-Procedure TTestTypeParser.TestStaticArray;
+procedure TTestTypeParser.TestStaticArray;
 begin
   DoParseArray('array [0..2] of integer','',Nil);
   AssertEquals('Array type','0..2',TPasArrayType(TheType).IndexRange);
 end;
 
-Procedure TTestTypeParser.TestStaticArrayComment;
+procedure TTestTypeParser.TestStaticArrayComment;
 begin
   AddComment:=True;
   TestStaticArray;
@@ -2809,26 +2810,26 @@ begin
   AssertEquals('Array type','0..2',TPasArrayType(TheType).IndexRange);
 end;
 
-Procedure TTestTypeParser.TestStaticArrayPacked;
+procedure TTestTypeParser.TestStaticArrayPacked;
 begin
   DoParseArray('packed array [0..2] of integer','',Nil);
   AssertEquals('Array type','0..2',TPasArrayType(TheType).IndexRange);
   AssertEquals('Packed',True,TPasArrayType(TheType).IsPacked);
 end;
 
-Procedure TTestTypeParser.TestStaticArrayTypedIndex;
+procedure TTestTypeParser.TestStaticArrayTypedIndex;
 begin
   DoParseArray('array [Boolean] of integer','',Nil);
   AssertEquals('Array type','Boolean',TPasArrayType(TheType).IndexRange);
 end;
 
-Procedure TTestTypeParser.TestDynamicArray;
+procedure TTestTypeParser.TestDynamicArray;
 begin
   DoParseArray('array of integer','',Nil);
   AssertEquals('Array type','',TPasArrayType(TheType).IndexRange);
 end;
 
-Procedure TTestTypeParser.TestDynamicArrayComment;
+procedure TTestTypeParser.TestDynamicArrayComment;
 begin
   AddComment:=True;
   DoParseArray('array of integer','',Nil);
@@ -2836,7 +2837,7 @@ begin
   AssertComment;
 end;
 
-Procedure TTestTypeParser.TestSimpleEnumerated;
+procedure TTestTypeParser.TestSimpleEnumerated;
 
 begin
   DoParseEnumerated('(one,two,three)','',3);
@@ -2848,7 +2849,7 @@ begin
   AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
 end;
 
-Procedure TTestTypeParser.TestSimpleEnumeratedComment;
+procedure TTestTypeParser.TestSimpleEnumeratedComment;
 begin
   AddComment:=True;
   TestSimpleEnumerated;
@@ -2858,7 +2859,7 @@ begin
   AssertEquals('No comment on enum 2','',TPasEnumValue(TPasEnumType(TheType).Values[2]).DocComment);
 end;
 
-Procedure TTestTypeParser.TestSimpleEnumeratedComment2;
+procedure TTestTypeParser.TestSimpleEnumeratedComment2;
 begin
   AddComment:=True;
   DoParseEnumerated('( {a} one, {b} two, {c} three)','',3);
@@ -2867,7 +2868,7 @@ begin
   AssertEquals('comment on enum 2','c'+sLineBreak,TPasEnumValue(TPasEnumType(TheType).Values[2]).DocComment);
 end;
 
-Procedure TTestTypeParser.TestSimpleEnumeratedDeprecated;
+procedure TTestTypeParser.TestSimpleEnumeratedDeprecated;
 begin
   DoParseEnumerated('(one,two,three)','deprecated',3);
   AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
@@ -2878,7 +2879,7 @@ begin
   AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
 end;
 
-Procedure TTestTypeParser.TestSimpleEnumeratedPlatform;
+procedure TTestTypeParser.TestSimpleEnumeratedPlatform;
 begin
   DoParseEnumerated('(one,two,three)','platform',3);
   AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
@@ -2889,7 +2890,7 @@ begin
   AssertEquals('Assigned value third enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
 end;
 
-Procedure TTestTypeParser.TestAssignedEnumerated;
+procedure TTestTypeParser.TestAssignedEnumerated;
 begin
   DoParseEnumerated('(one,two:=2,three)','',3);
   AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
@@ -2900,7 +2901,7 @@ begin
   AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
 end;
 
-Procedure TTestTypeParser.TestAssignedEnumeratedDeprecated;
+procedure TTestTypeParser.TestAssignedEnumeratedDeprecated;
 begin
   DoParseEnumerated('(one,two:=2,three)','',3);
   AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
@@ -2911,7 +2912,7 @@ begin
   AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
 end;
 
-Procedure TTestTypeParser.TestAssignedEnumeratedPlatform;
+procedure TTestTypeParser.TestAssignedEnumeratedPlatform;
 begin
   DoParseEnumerated('(one,two:=2,three)','',3);
   AssertEquals('First enumerated value','one',TPasEnumValue(TPasEnumType(TheType).Values[0]).Name);
@@ -2922,73 +2923,73 @@ begin
   AssertEquals('Assigned value first enumerated empty','',TPasEnumValue(TPasEnumType(TheType).Values[2]).AssignedValue);
 end;
 
-Procedure TTestTypeParser.TestFileType;
+procedure TTestTypeParser.TestFileType;
 begin
   DoTestFileType('integer','');
 end;
 
-Procedure TTestTypeParser.TestFileTypeDeprecated;
+procedure TTestTypeParser.TestFileTypeDeprecated;
 begin
   DoTestFileType('integer','deprecated');
 end;
 
-Procedure TTestTypeParser.TestFileTypePlatform;
+procedure TTestTypeParser.TestFileTypePlatform;
 begin
   DoTestFileType('integer','platform');
 end;
 
-Procedure TTestTypeParser.TestRangeType;
+procedure TTestTypeParser.TestRangeType;
 begin
   DoTestRangeType('1','4','');
 end;
 
-Procedure TTestTypeParser.TestRangeTypeDeprecated;
+procedure TTestTypeParser.TestRangeTypeDeprecated;
 begin
   DoTestRangeType('1','4','deprecated');
 end;
 
-Procedure TTestTypeParser.TestRangeTypePlatform;
+procedure TTestTypeParser.TestRangeTypePlatform;
 begin
   DoTestRangeType('1','4','platform');
 end;
 
-Procedure TTestTypeParser.TestIdentifierRangeType;
+procedure TTestTypeParser.TestIdentifierRangeType;
 begin
   DoTestRangeType('tkFirst','tkLast','');
 end;
 
-Procedure TTestTypeParser.TestIdentifierRangeTypeDeprecated;
+procedure TTestTypeParser.TestIdentifierRangeTypeDeprecated;
 begin
   DoTestRangeType('tkFirst','tkLast','deprecated');
 end;
 
-Procedure TTestTypeParser.TestIdentifierRangeTypePlatform;
+procedure TTestTypeParser.TestIdentifierRangeTypePlatform;
 begin
   DoTestRangeType('tkFirst','tkLast','platform');
 end;
 
-Procedure TTestTypeParser.TestNegativeIdentifierRangeType;
+procedure TTestTypeParser.TestNegativeIdentifierRangeType;
 begin
   DoTestRangeType('-tkLast','tkLast','');
 end;
 
-Procedure TTestTypeParser.TestSimpleSet;
+procedure TTestTypeParser.TestSimpleSet;
 begin
   DoParseSimpleSet('Byte','');
 end;
 
-Procedure TTestTypeParser.TestSimpleSetDeprecated;
+procedure TTestTypeParser.TestSimpleSetDeprecated;
 begin
   DoParseSimpleSet('Byte','deprecated');
 end;
 
-Procedure TTestTypeParser.TestSimpleSetPlatform;
+procedure TTestTypeParser.TestSimpleSetPlatform;
 begin
   DoParseSimpleSet('Byte','platform');
 end;
 
 
-Procedure TTestTypeParser.TestComplexSet;
+procedure TTestTypeParser.TestComplexSet;
 
 
 begin
@@ -2996,64 +2997,69 @@ begin
   DoTestComplexSet;
 end;
 
-Procedure TTestTypeParser.TestComplexSetDeprecated;
+procedure TTestTypeParser.TestComplexSetDeprecated;
 
 begin
   DoParseComplexSet('(one, two, three)','deprecated');
   DoTestComplexSet;
 end;
 
-Procedure TTestTypeParser.TestComplexSetPlatform;
+procedure TTestTypeParser.TestComplexSetPlatform;
 
 begin
   DoParseComplexSet('(one, two, three)','platform');
   DoTestComplexSet;
 end;
 
-Procedure TTestTypeParser.TestRangeSet;
+procedure TTestTypeParser.TestRangeSet;
 begin
   // TRange = (rLow, rMiddle, rHigh);
   DoParseRangeSet('rMiddle..high(TRange)','');
 end;
 
-Procedure TTestTypeParser.TestSubRangeSet;
+procedure TTestTypeParser.TestSubRangeSet;
 begin
   DoParseRangeSet('0..SizeOf(Integer)*8-1','');
 end;
 
-Procedure TTestTypeParser.TestRangeSetDeprecated;
+procedure TTestTypeParser.TestRangeSetDeprecated;
 begin
   DoParseRangeSet('0..SizeOf(Integer)*8-1','deprecated');
 end;
 
-Procedure TTestTypeParser.TestRangeSetPlatform;
+procedure TTestTypeParser.TestRangeSetPlatform;
 begin
   DoParseRangeSet('0..SizeOf(Integer)*8-1','platform');
 end;
 
-Procedure TTestTypeParser.TestClassOf;
+procedure TTestTypeParser.TestNegativeRangeType;
+begin
+  DoTestRangeType('2-1','3','');
+end;
+
+procedure TTestTypeParser.TestClassOf;
 begin
   DoTestClassOf('');
 end;
 
-Procedure TTestTypeParser.TestClassOfComment;
+procedure TTestTypeParser.TestClassOfComment;
 begin
   AddComment:=True;
   DoTestClassOf('');
   AssertComment;
 end;
 
-Procedure TTestTypeParser.TestClassOfDeprecated;
+procedure TTestTypeParser.TestClassOfDeprecated;
 begin
   DoTestClassOf('deprecated');
 end;
 
-Procedure TTestTypeParser.TestClassOfPlatform;
+procedure TTestTypeParser.TestClassOfPlatform;
 begin
   DoTestClassOf('Platform');
 end;
 
-Procedure TTestTypeParser.TestReferenceAlias;
+procedure TTestTypeParser.TestReferenceAlias;
 begin
   Add('Type');
   Add(' Type1 = Integer;');
@@ -3068,7 +3074,7 @@ begin
   AssertSame('Second declaration references first.',Declarations.Types[0],TPasAliasType(Declarations.Types[1]).DestType);
 end;
 
-Procedure TTestTypeParser.TestReferenceSet;
+procedure TTestTypeParser.TestReferenceSet;
 
 begin
   Add('Type');
@@ -3084,7 +3090,7 @@ begin
   AssertSame('Second declaration references first.',Declarations.Types[0],TPasSetType(Declarations.Types[1]).EnumType);
 end;
 
-Procedure TTestTypeParser.TestReferenceClassOf;
+procedure TTestTypeParser.TestReferenceClassOf;
 begin
   Add('Type');
   Add(' Type1 = Class(TObject);');
@@ -3100,7 +3106,7 @@ begin
   AssertSame('Second declaration references first.',Declarations.Classes[0],TPasClassOfType(Declarations.Types[0]).DestType);
 end;
 
-Procedure TTestTypeParser.TestReferenceFile;
+procedure TTestTypeParser.TestReferenceFile;
 begin
   Add('Type');
   Add(' Type1 = (a,b,c);');
@@ -3115,7 +3121,7 @@ begin
   AssertSame('Second declaration references first.',Declarations.Types[0],TPasFileType(Declarations.Types[1]).elType);
 end;
 
-Procedure TTestTypeParser.TestReferenceArray;
+procedure TTestTypeParser.TestReferenceArray;
 begin
   Add('Type');
   Add(' Type1 = (a,b,c);');
@@ -3130,7 +3136,7 @@ begin
   AssertSame('Second declaration references first.',Declarations.Types[0],TPasArrayType(Declarations.Types[1]).elType);
 end;
 
-Procedure TTestTypeParser.TestReferencePointer;
+procedure TTestTypeParser.TestReferencePointer;
 begin
   Add('Type');
   Add(' Type1 = (a,b,c);');

packages/hash/src/sha1.pp

@@ -313,7 +313,10 @@ var
   A: array[0..4] of Cardinal absolute Digest1;
   B: array[0..4] of Cardinal absolute Digest2;
 begin
+{$push}
+{$B+}
   Result := (A[0] = B[0]) and (A[1] = B[1]) and (A[2] = B[2]) and (A[3] = B[3]) and (A[4] = B[4]);
+{$pop}
 end;
 
 end.

rtl/objpas/sysutils/sysstrh.inc

@@ -39,7 +39,7 @@ const
   MaxDateTime: TDateTime =  2958465.99999; { 12/31/9999 11:59:59.999 PM }
 
 {$if defined(FPC_HAS_TYPE_EXTENDED) or defined(FPC_HAS_TYPE_FLOAT128)}
-  MinCurrency: Currency = -922337203685477.5807;
+  MinCurrency: Currency = -922337203685477.5808;
   MaxCurrency: Currency =  922337203685477.5807;
 {$else}
   MinCurrency: Currency = -922337203685477.0000;

utils/fpdoc/dglobals.pp

@@ -132,6 +132,8 @@ resourcestring
   SCHMUsageMakeSearch = 'Automatically generate a Search Index from filenames that match *.htm*';
   SCHMUsageChmTitle= 'Title of the chm. Defaults to the value from --package';
 
+  SXMLUsageSource  = 'Include source file and line info in generated XML';
+
   // Linear usage
   SLinearUsageDupLinkedDocsP1 = 'Duplicate linked element documentation in';
   SLinearUsageDupLinkedDocsP2 = 'descendant classes.';

utils/fpdoc/dw_xml.pp

@@ -23,15 +23,20 @@ unit dw_XML;
 
 interface
 
-uses DOM, PasTree, dGlobals, dwriter, xmlWrite, SysUtils;
+uses DOM, PasTree, dGlobals, dwriter, xmlWrite, SysUtils, Classes;
 
 Type
 
   { TXMLWriter }
 
   TXMLWriter = Class(TFPDocWriter)
+  private
+    FShowSourceInfo: Boolean;
+  public
     function ModuleToXMLStruct(AModule: TPasModule): TXMLDocument;
     Procedure WriteDoc; override;
+    class procedure Usage(List: TStrings); override;
+    function  InterPretOption(const Cmd,Arg : String): boolean; override;
   end;
 
 
@@ -39,18 +44,179 @@ Type
 
 implementation
 
+const
+  DefaultVisibility = [visDefault, visPublic, visPublished, visProtected];
+
 function TXMLWriter.ModuleToXMLStruct(AModule: TPasModule): TXMLDocument;
 
 var
   ModuleElement: TDOMElement;
+  Doc: TXMLDocument absolute Result;
+
+  function VisibilityToString(vis: TPasMemberVisibility): String;
+  begin
+    case vis of
+      visDefault         : Result := '';
+      visPrivate         : Result := 'private';
+      visProtected       : Result := 'protected';
+      visPublic          : Result := 'public';
+      visPublished       : Result := 'published';
+      visAutomated       : Result := 'automated';
+      visStrictPrivate   : Result := 'strictprivate';
+      visStrictProtected : Result := 'strictprotected';
+    end;
+  end;
+
+  function Sanitize(AString: String): String;
+  var
+    i: Integer;
+  begin
+    Result := AString;
+    for i := 1 to length(Result) do
+      if Result[i] in [' '] then
+        Result[i] := '_';
+  end;
+
+  procedure AddSourceInfo(ADecl: TPasElement; AElement: TDOMElement);
+  var
+    SourceNode: TDOMElement;
+  begin
+    if not FShowSourceInfo then
+      Exit;
+    SourceNode := Doc.CreateElement('source');
+    SourceNode['line'] := IntToStr(ADecl.SourceLinenumber);
+    SourceNode['file'] := ADecl.SourceFilename;
+    AElement.AppendChild(SourceNode);
+  end;
+
+  procedure AddProcedureModifiers(ADecl: TPasProcedure; Node: TDOMElement);
+  begin
+    {pmVirtual , pmDynamic, pmAbstract, pmOverride,
+    pmExport, pmOverload, pmMessage, pmReintroduce,
+    pmStatic,pmInline,pmAssembler,pmVarargs, pmPublic,
+    pmCompilerProc,pmExternal,pmForward}
+
+    if (pmVirtual in ADecl.Modifiers) or (pmDynamic in ADecl.Modifiers) then
+      Node['virtual'] := 'true';
+    if pmAbstract in ADecl.Modifiers then
+      Node['abstract'] := 'true';
+    if pmStatic in ADecl.Modifiers then
+      Node['static'] := 'true';
+    if pmReintroduce in ADecl.Modifiers then
+      Node['reintroduce'] := 'true';
+    if pmOverload in ADecl.Modifiers then
+      Node['overload'] := 'true';
+    if pmForward in ADecl.Modifiers then
+      Node['forward'] := 'true';
+    if pmOverride in ADecl.Modifiers then
+      Node['override'] := 'true';
+  end;
+
+  procedure AddTypeNode(ToNode: TDOMElement; AType: String);
+  begin
+    ToNode.AttribStrings['type'] := AType;
+  end;
 
-  procedure ProcessProcedure(Proc: TPasProcedure; Element: TDOMElement);
+  function AddTypeNode(ToNode: TDOMElement; AType: TPasType): Boolean;
+  //var
+  //  TypeNode: TDOMElement;
+  begin
+    Result := False;
+    if not Assigned(AType) then
+      Exit;
+    //TypeNode := Doc.CreateElement('type');
+    //TypeNode.TextContent:=AType.Name;
+    //ToNode.AppendChild(TypeNode);
+    AddTypeNode(ToNode, AType.Name);
+    Result := True;
+  end;
+
+  procedure ProcessArgs(Args: TFPList; ProcNode: TDomElement);
+  var
+    i: Integer;
+    ArgNode: TDOMElement;
+    Arg: TPasArgument;
+  begin
+    for i := 0 to Args.Count-1 do
+    begin
+      Arg := TPasArgument(Args.Items[i]);
+      ArgNode := Doc.CreateElement('argument');
+      ArgNode.AttribStrings['name'] := Arg.Name;
+      AddTypeNode(ArgNode, Arg.ArgType);
+      ProcNode.AppendChild(ArgNode);
+    end;
+  end;
+
+  procedure DoVisibility(PasEl: TPasElement; Element: TDOMElement);
+  begin
+    if PasEl.Visibility <> visDefault then
+      Element['visibility'] := VisibilityToString(PasEl.Visibility);
+  end;
+
+  function ProcessProcedure(Proc: TPasProcedure; Element: TDOMElement): TDOMElement;
   var
     ProcEl: TDOMElement;
+    ReturnEl: TDOMElement;
   begin
-    ProcEl := Result.CreateElement(Proc.TypeName);
+    Result := nil;
+    ProcEl := Doc.CreateElement(Sanitize(Proc.TypeName));
     Element.AppendChild(ProcEl);
     ProcEl['name'] := Proc.Name;
+
+    DoVisibility(Proc, ProcEl);
+
+    AddProcedureModifiers(Proc, ProcEl);
+    AddSourceInfo(Proc,ProcEl);
+
+    if Proc.InheritsFrom(TPasFunction) then
+    begin
+      ReturnEl := Doc.CreateElement('return');
+      ProcEl.AppendChild(ReturnEl);
+      AddTypeNode(ReturnEl, TPasFunction(Proc).FuncType.ResultEl.ResultType);
+    end;
+
+    ProcessArgs(Proc.ProcType.Args, ProcEl);
+
+    Result := ProcEl;
+  end;
+
+  procedure ProcessArrayType(AType: TPasArrayType; Element: TDOMElement);
+  var
+    TypeEl: TDOMElement;
+  begin
+    TypeEl := Doc.CreateElement('array');
+    TypeEl['name'] := AType.Name;
+    if not AddTypeNode(TypeEl, AType.ElType) then
+      TypeEl['const'] := 'true';
+    TypeEl['range'] := AType.IndexRange;
+    DoVisibility(AType, Element);
+    AddSourceInfo(AType,Element);
+    Element.AppendChild(TypeEl);
+  end;
+
+  procedure ProcessPointerType(AType: TPasPointerType; Element: TDOMElement);
+  var
+    TypeEl: TDOMElement;
+  begin
+    TypeEl := Doc.CreateElement('pointer');
+    TypeEl['name'] := AType.Name;
+    AddTypeNode(TypeEl, AType.DestType);
+    DoVisibility(AType, Element);
+    AddSourceInfo(AType,Element);
+
+    Element.AppendChild(TypeEl);
+  end;
+
+  procedure ProcessAliasType(AType: TPasAliasType; Element: TDOMElement);
+  var
+    TypeEl: TDOMElement;
+  begin
+    TypeEl := Doc.CreateElement('alias');
+    TypeEl['name'] := AType.Name;
+    AddTypeNode(TypeEl, AType.DestType);
+    DoVisibility(AType, Element);
+    AddSourceInfo(AType,Element);
+    Element.AppendChild(TypeEl);
   end;
 
   procedure ProcessVariable(AVar: TPasVariable; Element: TDOMElement);
@@ -60,8 +226,291 @@ var
     VarEl := Result.CreateElement('var');
     Element.AppendChild(VarEl);
     VarEl['name'] := AVar.Name;
+    if not AVar.VarType.InheritsFrom(TPasArrayType) then
+      AddTypeNode(VarEl, AVar.VarType)
+    else
+    begin
+      VarEl['array'] := 'true';
+      ProcessArrayType(TPasArrayType(AVar.VarType), VarEl);
+    end;
+    DoVisibility(Avar, VarEl);
+    AddSourceInfo(AVar,VarEl);
+  end;
+
+  procedure ProcessProperty(AProp: TPasProperty; Element: TDOMElement);
+  var
+    PropEl: TDOMElement;
+  begin
+    PropEl := Doc.CreateElement('property');
+    Element.AppendChild(PropEl);
+
+    PropEl.AttribStrings['name'] := AProp.Name;
+    AddTypeNode(PropEL, AProp.ResolvedType);
+
+    if AProp.IndexValue <> '' then
+      PropEl['index'] := AProp.IndexValue;
+
+    if AProp.DefaultValue <> '' then
+      PropEl['default'] := AProp.DefaultValue;
+
+
+    if AProp.WriteAccessorName <> '' then
+      PropEl.AttribStrings['writable'] := 'true';
+
+    ProcessArgs(AProp.Args, PropEl);
+    DoVisibility(AProp, Element);
+    AddSourceInfo(AProp,PropEl);
+
+    // this isn't quite right
+    //if AProp.ReadAccessorName = '' then
+    //  PropEl.AttribStrings['inherited'] := 'true';
+  end;
+
+  procedure ProcessOverloadedProcedure(AOverload: TPasOverloadedProc; Element: TDOMElement);
+  var
+    OverEl: TDOMElement;
+    i: Integer;
+  begin
+    for i := 0 to AOverload.Overloads.Count-1 do
+    begin
+      OverEl := ProcessProcedure(TPasProcedure(AOverload.Overloads.Items[i]), Element);
+      OverEl['overload'] := 'true';
+    end;
+  end;
+
+  procedure ProcessConst(AConst: TPasConst; Element: TDOMElement);
+  var
+    ConstEl: TDOMElement;
+  begin
+    ConstEl := Doc.CreateElement('const');
+    ConstEl['name'] := AConst.name;
+    ConstEl['value'] := AConst.Value;
+    Element.AppendChild(ConstEl);
+    AddSourceInfo(AConst,ConstEl);
+  end;
+
+  procedure ProcessEnumType(AType: TPasEnumType; Element: TDOMElement);
+  var
+    TypeEl: TDOMElement;
+    ValEl: TDOMELement;
+    i: Integer;
+  begin
+    TypeEl := Doc.CreateElement('enum');
+    TypeEl['name'] := AType.name;
+    AddSourceInfo(AType,TypeEl);
+    //ConstEl['value'] := AConst.Value;
+    for i := 0 to AType.Values.Count-1 do
+    begin
+      ValEl := Doc.CreateElement('enumvalue');
+      ValEl['name'] := TPasEnumValue(AType.Values.Items[i]).Name;
+      AddSourceInfo(TPasEnumValue(AType.Values.Items[i]),ValEl);
+      TypeEl.AppendChild(ValEl);
+
+    end;
+    Element.AppendChild(TypeEl);
+  end;
+
+  procedure ProcessSetType(AType: TPasSetType; Element: TDOMElement);
+  var
+    SetEl: TDOMElement;
+  begin
+    SetEl := Doc.CreateElement('set');
+    SetEl['name'] := AType.name;
+    AddTypeNode(SetEl, AType.EnumType);
+    AddSourceInfo(AType,SetEl);
+    Element.AppendChild(SetEl);
+  end;
+
+  procedure ProcessProcedureType(AType: TPasProcedureType; Element: TDOMElement);
+  var
+    TypeEl: TDOMElement;
+  begin
+    TypeEl := Doc.CreateElement(AType.TypeName);
+    TypeEl['name'] := AType.name;
+    TypeEl['istype'] := 'true';
+    if AType.IsOfObject then
+      TypeEl['object'] := 'true';
+    ProcessArgs(AType.Args, TypeEl);
+    AddSourceInfo(AType,TypeEl);
+    Element.AppendChild(TypeEl);
+  end;
+
+  procedure ProcessRecordType(AType: TPasRecordType; Element: TDOMElement);
+  var
+    TypeEl: TDOMElement;
+    Decl: TPasElement;
+    i: Integer;
+  begin
+    TypeEl := Doc.CreateElement('record');
+    TypeEl['name'] := AType.name;
+
+    Element.AppendChild(TypeEl);
+    AddSourceInfo(AType,TypeEl);
+
+    if Assigned(AType.Members) then
+      for i := 0 to AType.Members.Count - 1 do
+      begin
+        Decl := TPasElement(AType.Members[i]);
+        if Decl.InheritsFrom(TPasProcedure)then
+          ProcessProcedure(TPasProcedure(Decl), TypeEl)
+        else if Decl.ClassType = TPasVariable then
+          ProcessVariable(TPasVariable(Decl), TypeEl)
+        else if Decl.ClassType = TPasProperty then
+          ProcessProperty(TPasProperty(Decl), TypeEl)
+        else writeln('Unhandled record member: ', Decl.ClassName, ' ', Decl.Name);
+      end;
+  end;
+
+  procedure ProcessGenericTypes(AGenericTypes: TFPList; ANode: TDOMElement);
+  var
+    i: Integer;
+    Node: TDOMElement;
+  begin
+    for i := 0 to AGenericTypes.Count-1 do
+    begin
+      Node := Doc.CreateElement('t');
+      Node['name'] := TPasGenericTemplateType(AGenericTypes.Items[i]).Name;
+      ANode.AppendChild(Node);
+      AddSourceInfo(TPasGenericTemplateType(AGenericTypes.Items[i]),Node);
+    end;
+  end;
+
+  procedure ProcessRangeType(AType: TPasRangeType; Element: TDOMElement);
+  var
+    TypeEl: TDOMElement;
+  begin
+    TypeEl := Doc.CreateElement('range');
+    TypeEl['name'] := AType.Name;
+    TypeEl['start'] := AType.RangeStart;
+    TypeEl['end'] := AType.RangeEnd;
+    AddSourceInfo(AType,TypeEl);
+
+    Element.AppendChild(TypeEl);
+
+  end;
+
+  procedure ProcessClassType(AClass: TPasClassType; Element: TDOMElement); forward;
+
+  function ProcessType(AType: TPasElement; Element: TDOMElement): Boolean;
+  begin
+    Result := True;
+    if AType.ClassType = TPasVariable then
+      ProcessVariable(TPasVariable(AType), Element)
+    else if AType.ClassType = TPasProperty then
+      ProcessProperty(TPasProperty(AType), Element)
+    else if AType.InheritsFrom(TPasOverloadedProc) then
+      ProcessOverloadedProcedure(TPasOverloadedProc(AType), Element)
+    else if AType.InheritsFrom(TPasConst) then
+      ProcessConst(TPasConst(AType), Element)
+    else if AType.InheritsFrom(TPasEnumType) then
+      ProcessEnumType(TPasEnumType(AType), Element)
+    else if AType.InheritsFrom(TPasClassType) then
+      ProcessClassType(TPasClassType(AType), Element)
+    else if AType.InheritsFrom(TPasAliasType) then
+      ProcessAliasType(TPasAliasType(AType), Element)
+    else if AType.InheritsFrom(TPasSetType) then
+      ProcessSetType(TPasSetType(AType), Element)
+    else if AType.InheritsFrom(TPasProcedureType) then
+      ProcessProcedureType(TPasProcedureType(AType), Element)
+    else if AType.InheritsFrom(TPasRecordType) then
+      ProcessRecordType(TPasRecordType(AType), Element)
+    else if AType.InheritsFrom(TPasArrayType) then
+      ProcessArrayType(TPasArrayType(AType), Element)
+    else if AType.InheritsFrom(TPasPointerType) then
+      ProcessPointerType(TPasPointerType(AType), Element)
+    else if AType.InheritsFrom(TPasRangeType) then
+      ProcessRangeType(TPasRangeType(AType), Element)
+    else
+      Result := False;
+  end;
+
+  procedure ProcessClassType(AClass: TPasClassType; Element: TDOMElement);
+  var
+    ClassEl: TDOMElement = nil;
+    i: Integer;
+    Decl: TPasElement;
+    SubNode: TDomElement;
+    InterfaceEl: TDomElement;
+    Vis: TPasMemberVisibilities = DefaultVisibility;
+  begin
+    if not Engine.HidePrivate then Include(Vis, visPrivate);
+    if Engine.HideProtected then Exclude(Vis, visProtected);
+    case AClass.ObjKind of
+      okClass: ClassEl := Result.CreateElement('class');
+      okObject: ClassEl := Result.CreateElement('object');
+      okInterface: ClassEl := Result.CreateElement('interface');
+      okSpecialize: ClassEl := Result.CreateElement('classspecialized');
+      //okGeneric: Result.CreateElement('generic');
+      //okClassHelper: Result.CreateElement('classhelper');
+      //okRecordHelper: Result.CreateElement('recordhelper');
+      //okTypeHelper: Result.CreateElement('typehelper');
+
+    else
+      //raise Exception.Create('ProcessClass: unknown class kind');
+      WriteLn('Unhandled Class kind: ', AClass.ObjKind);
+    end;
+
+    if Assigned(ClassEl) then
+    begin
+      Element.AppendChild(ClassEl);
+      ClassEl['name'] := AClass.Name;
+      if Assigned(AClass.AncestorType) then
+        ClassEl['parentclass'] := AClass.AncestorType.Name;
+
+      if AClass.ObjKind = okSpecialize then
+      begin
+        ProcessGenericTypes(AClass.GenericTemplateTypes, ClassEl);
+      end;
+      AddSourceInfo(AClass,ClassEl);
+
+      if Assigned(AClass.Interfaces) then
+        for i := 0 to AClass.Interfaces.Count-1 do
+        begin
+          InterfaceEl := Doc.CreateElement('interface');
+          ClassEl.AppendChild(InterfaceEl);
+          InterfaceEl['name'] := TPasElement(AClass.Interfaces.Items[i]).Name;
+        end;
+
+      if Assigned(AClass.Members) then
+      for i := 0 to AClass.Members.Count - 1 do
+      begin
+        Decl := TPasElement(AClass.Members[i]);
+        if not (Decl.Visibility in Vis) then
+          continue;
+        if Decl.InheritsFrom(TPasProcedure)then
+        begin
+          SubNode := ProcessProcedure(TPasProcedure(Decl), ClassEl);
+          if Assigned(SubNode) then
+          begin
+            if SubNode.InheritsFrom(TPasClassConstructor) then
+              SubNode.SetAttribute('type', 'constructor')
+            else if SubNode.InheritsFrom(TPasClassDestructor) then
+              SubNode.SetAttribute('type', 'destructor');
+          end;
+        end
+        else if not ProcessType(Decl, ClassEl) then
+          writeln('Unhandled class member: ', Decl.ClassName, ' ', Decl.Name);
+      end;
+    end;
+  end;
+
+  function FindInList(AName: String; AList: TFPList): Boolean;
+  var
+    El: TPasElement;
+    I: Integer;
+  begin
+    Result := False;
+    I := 0;
+    while not Result and (I < AList.Count) do
+    begin
+      El := TPasElement(AList[I]);
+      if El.Name = AName then
+        Result := True;
+      Inc(I);
+    end;
   end;
 
+
   procedure ProcessSection(ASection: TPasSection; const Name: DOMString);
   var
     Element, UsesElement, UnitElement: TDOMElement;
@@ -82,6 +531,25 @@ var
       end;
     end;
 
+    for i := 0 to ASection.Classes.Count -1 do
+    begin
+      Decl := TPasElement(ASection.Classes[i]);
+      ProcessClassType(TPasClassType(Decl), Element);
+    end;
+
+    for i := 0 to ASection.Consts.Count - 1 do
+    begin
+      Decl := TPasElement(ASection.Consts[i]);
+      ProcessConst(TPasConst(Decl), Element)
+    end;
+
+    for i := 0 to ASection.Types.Count - 1 do
+    begin
+      Decl := TPasElement(ASection.Types[i]);
+      if not ProcessType(Decl, Element) then
+        WriteLn('Unhandled type: ',Decl.ClassName, ' ', Decl.Name);
+    end;
+
     for i := 0 to ASection.Declarations.Count - 1 do
     begin
       Decl := TPasElement(ASection.Declarations[i]);
@@ -90,6 +558,23 @@ var
       else if Decl.ClassType = TPasVariable then
         ProcessVariable(TPasVariable(Decl), Element);
     end;
+
+    for i := 0 to ASection.Functions.Count - 1 do
+    begin
+      // many of these (all?) seem to be in ASection.Declarations
+      Decl := TPasElement(ASection.Functions[i]);
+      if FindInList(Decl.Name, ASection.Declarations) then
+        WriteLn('Duplicate proc definition in declarations. Skipping: ', Decl.Name)
+      else
+        WriteLn('Unhandled function: ',Decl.ClassName, ' ', Decl.Name);
+
+    end;
+
+    for i := 0 to ASection.Properties.Count - 1 do
+    begin
+      Decl := TPasElement(ASection.Properties[i]);
+      ProcessProperty(TPasProperty(Decl), Element);
+    end;
   end;
 
 
@@ -121,6 +606,20 @@ begin
   end;
 end;
 
+class procedure TXMLWriter.Usage(List: TStrings);
+begin
+  List.AddStrings(['--source-info', SXMLUsageSource]);
+end;
+
+function TXMLWriter.InterPretOption(const Cmd, Arg: String): boolean;
+begin
+  Result := True;
+  if Cmd = '--source-info' then
+    FShowSourceInfo:=True
+  else
+    Result:=inherited InterPretOption(Cmd, Arg);
+end;
+
 initialization
   // Do not localize.
   RegisterWriter(TXMLWriter,'xml','fpdoc XML output.');

utils/fpdoc/fpdocclasstree.pp

@@ -162,7 +162,7 @@ begin
     end;
   If (N<>Nil) then
     Result:=N as TDomElement
-  else
+  else if AElement.Name<>'' then
     begin // N=NIL, PE might be nil.
     Inc(ACount);
     Result:=FClassTree.CreateElement(AElement.Name);

utils/fppkg/lnet/lnet.pp

@@ -89,6 +89,7 @@ type
     FCreator: TLComponent;
     FSession: TLSession;
     FConnection: TLConnection;
+    FMSGBufferSize: integer;
    protected
     function GetConnected: Boolean; virtual; deprecated;
     function GetConnecting: Boolean; virtual; deprecated;
@@ -156,6 +157,7 @@ type
     property SocketState: TLSocketStates read FSocketState;
     property Creator: TLComponent read FCreator;
     property Session: TLSession read FSession;
+    Property MsgBufferSize : Integer Read FMsgBufferSize Write FMsgBufferSize;
   end;
   TLSocketClass = class of TLSocket;
   
@@ -436,6 +438,7 @@ begin
   FSocketType := SOCK_STREAM;
   FSocketNet := LAF_INET;
   FProtocol := LPROTO_TCP;
+  FMSGBufferSize := 0;
 end;
 
 destructor TLSocket.Destroy;
@@ -715,18 +718,26 @@ begin
         Opt := Integer(not Opt);
       {$endif}
       if fpsetsockopt(FHandle, SOL_SOCKET, Opt, @Arg, Sizeof(Arg)) = SOCKET_ERROR then
-        Exit(Bail('SetSockOpt error', LSocketError));
+        Exit(Bail('SetSockOpt error setting reuseaddr', LSocketError));
     end;
     
     {$ifdef darwin}
     Arg := 1;
     if fpsetsockopt(FHandle, SOL_SOCKET, SO_NOSIGPIPE, @Arg, Sizeof(Arg)) = SOCKET_ERROR then
-      Exit(Bail('SetSockOpt error', LSocketError));
+      Exit(Bail('SetSockOpt error setting nosigpipe', LSocketError));
     {$endif}
     
     FillAddressInfo(FAddress, FSocketNet, Address, aPort);
     FillAddressInfo(FPeerAddress, FSocketNet, LADDR_BR, aPort);
-
+    if FMSGBufferSize>0 then
+      begin
+      if fpsetsockopt(Handle, SOL_SOCKET, SO_RCVBUF, @FMSGBufferSize, Sizeof(integer))
+        = SOCKET_ERROR then
+        Exit(Bail('SetSockOpt error setting rcv buffer size', LSocketError));
+      if fpsetsockopt(Handle, SOL_SOCKET, SO_SNDBUF, @FMSGBufferSize, Sizeof(integer))
+        = SOCKET_ERROR then
+        Exit(Bail('SetSockOpt error setting snd buffer size', LSocketError));
+      end;
     Result  :=  Done;
   end;
 end;
@@ -737,7 +748,7 @@ var
 begin
   if FSocketType = SOCK_STREAM then
     Result := Sockets.fpSend(FHandle, @aData, aSize, LMSG)
-  else
+  else 
     Result := sockets.fpsendto(FHandle, @aData, aSize, LMSG, @FPeerAddress, AddressLength);
 end;
 
@@ -805,6 +816,7 @@ begin
     Bail('Error on bind', LSocketError)
   else
     Result := true;
+
   if (FSocketType = SOCK_STREAM) and Result then
     if fpListen(FHandle, FListenBacklog) = SOCKET_ERROR then
       Result := Bail('Error on Listen', LSocketError)
@@ -836,7 +848,7 @@ begin
   
   if FConnectionStatus <> scNone then
     Disconnect(True);
-    
+
   if SetupSocket(APort, Address) then begin
     fpConnect(FHandle, GetIPAddressPointer, GetIPAddressLength);
     FConnectionStatus := scConnecting;