--- Merging r14005 into '.':fcl-web_joost

U    utils/fpdoc/dw_html.pp
U    rtl/inc/objpash.inc
U    rtl/inc/objpas.inc
U    rtl/objpas/classes/parser.inc
A    tests/test/tobject5.pp
U    compiler/nobj.pas
U    packages/fcl-passrc/src/pparser.pp


git-svn-id: http://svn.freepascal.org/svn/fpc/branches/fcl-web_joost@14654 3ad0048d-3df7-0310-abae-a5850022a9f2

7 files changed, 85 insertions, 17 deletions

diff --git a/compiler/nobj.pas b/compiler/nobj.pas
index 36a1305ef2..d9540e4d9d 100644
--- a/compiler/nobj.pas
+++ b/compiler/nobj.pas
@@ -417,7 +417,7 @@ implementation
         timpls    = array[0..1000] of longint;
         pimpls    = ^timpls;
       var
-        equals: pequals;
+        aequals: pequals;
         compats: pcompintfs;
         impls: pimpls;
         ImplIntfCount,
@@ -431,10 +431,10 @@ implementation
         if ImplIntfCount>=High(tequals) then
           Internalerror(200006135);
         getmem(compats,sizeof(tcompintfentry)*ImplIntfCount);
-        getmem(equals,sizeof(longint)*ImplIntfCount);
+        getmem(aequals,sizeof(longint)*ImplIntfCount);
         getmem(impls,sizeof(longint)*ImplIntfCount);
         filldword(compats^,(sizeof(tcompintfentry) div sizeof(dword))*ImplIntfCount,dword(-1));
-        filldword(equals^,ImplIntfCount,dword(-1));
+        filldword(aequals^,ImplIntfCount,dword(-1));
         filldword(impls^,ImplIntfCount,dword(-1));
         { ismergepossible is a containing relation
           meaning of ismergepossible(a,b,w) =
@@ -453,8 +453,8 @@ implementation
                 if cij and cji then { i equal j }
                   begin
                     { get minimum index of equal }
-                    if equals^[j]=-1 then
-                      equals^[j]:=i;
+                    if aequals^[j]=-1 then
+                      aequals^[j]:=i;
                   end
                 else if cij then
                   begin
@@ -491,8 +491,8 @@ implementation
             begin
               if compats^[impls^[i]].compintf<>-1 then
                 impls^[i]:=compats^[impls^[i]].compintf
-              else if equals^[impls^[i]]<>-1 then
-                impls^[i]:=equals^[impls^[i]]
+              else if aequals^[impls^[i]]<>-1 then
+                impls^[i]:=aequals^[impls^[i]]
               else
                 inc(k);
             end;
@@ -504,7 +504,7 @@ implementation
             ImplIntfI.VtblImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[impls^[i]]);
           end;
         freemem(compats);
-        freemem(equals);
+        freemem(aequals);
         freemem(impls);
       end;
 
diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp
index df8c64c674..66458fbd1c 100644
--- a/packages/fcl-passrc/src/pparser.pp
+++ b/packages/fcl-passrc/src/pparser.pp
@@ -872,18 +872,18 @@ end;
 // Starts after the "uses" token
 procedure TPasParser.ParseUsesList(ASection: TPasSection);
 var
-  UnitName: String;
+  AUnitName: String;
   Element: TPasElement;
 begin
   while True do
   begin
-    UnitName := ExpectIdentifier;
+    AUnitName := ExpectIdentifier;
 
-    Element := Engine.FindModule(UnitName);
+    Element := Engine.FindModule(AUnitName);
     if Assigned(Element) then
       Element.AddRef
     else
-      Element := TPasType(CreateElement(TPasUnresolvedTypeRef, UnitName,
+      Element := TPasType(CreateElement(TPasUnresolvedTypeRef, AUnitName,
         ASection));
     ASection.UsesList.Add(Element);
 
diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc
index 41539644db..090a5a0e79 100644
--- a/rtl/inc/objpas.inc
+++ b/rtl/inc/objpas.inc
@@ -711,6 +711,47 @@
           getinterfacetable:=PVmt(Self)^.vIntfTable;
         end;
 
+      class function TObject.UnitName : string;
+        type
+          // from the typinfo unit
+          TClassTypeInfo = {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
+            ClassType: TClass;
+            ParentInfo: Pointer;
+            PropCount: SmallInt;
+            UnitName: ShortString;
+          end;
+          PClassTypeInfo = ^TClassTypeInfo;
+        var
+          classtypeinfo: PClassTypeInfo;
+        begin
+          classtypeinfo:=ClassInfo;
+          if Assigned(classtypeinfo) then
+          begin
+            // offset PTypeInfo by Length(Name) + 2 (ShortString length byte + SizeOf(Kind))
+            inc(Pointer(classtypeinfo), PByte(Pointer(classtypeinfo)+1)^ + 2);
+            {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+            classtypeinfo:=align(classtypeinfo,sizeof(classtypeinfo));
+            {$endif}
+            result:=classtypeinfo^.UnitName;
+          end
+          else
+            result:='';
+        end;
+
+      function TObject.Equals(Obj: TObject) : boolean;
+        begin
+          result:=Obj=Self;
+        end;
+
+      function TObject.GetHashCode: PtrInt;
+        begin
+          result:=PtrInt(Self);
+        end;
+
+      function TObject.ToString: string;
+        begin
+          result:=ClassName;
+        end;
 {****************************************************************************
                                TINTERFACEDOBJECT
 ****************************************************************************}
diff --git a/rtl/inc/objpash.inc b/rtl/inc/objpash.inc
index f9563c6bb0..3971c10e25 100644
--- a/rtl/inc/objpash.inc
+++ b/rtl/inc/objpash.inc
@@ -54,6 +54,9 @@
        vmtAfterConstruction    = vmtMethodStart+sizeof(pointer)*5;
        vmtBeforeDestruction    = vmtMethodStart+sizeof(pointer)*6;
        vmtDefaultHandlerStr    = vmtMethodStart+sizeof(pointer)*7;
+       vmtEquals               = vmtMethodStart+sizeof(pointer)*10;
+       vmtGetHashCode          = vmtMethodStart+sizeof(pointer)*11;
+       vmtToString             = vmtMethodStart+sizeof(pointer)*12;
 
        { IInterface }
        S_OK          = 0;
@@ -113,6 +116,9 @@
          vAfterConstruction: Pointer;
          vBeforeDestruction: Pointer;
          vDefaultHandlerStr: Pointer;
+         vEquals: Pointer;
+         vGetHashCode: Pointer;
+         vToString: Pointer;
        end;
 
        PGuid = ^TGuid;
@@ -214,6 +220,12 @@
           class function GetInterfaceEntry(const iid : tguid) : pinterfaceentry;
           class function GetInterfaceEntryByStr(const iidstr : shortstring) : pinterfaceentry;
           class function GetInterfaceTable : pinterfacetable;
+
+          { new since Delphi 2009 }
+          class function UnitName : string;
+          function Equals(Obj: TObject) : boolean;virtual;
+          function GetHashCode: PtrInt;virtual;
+          function ToString: string;virtual;
        end;
 
        IUnknown = interface
diff --git a/rtl/objpas/classes/parser.inc b/rtl/objpas/classes/parser.inc
index 741cbba78b..cc8a04e5f7 100644
--- a/rtl/objpas/classes/parser.inc
+++ b/rtl/objpas/classes/parser.inc
@@ -261,7 +261,7 @@ begin
       else break;
     end;
   if ascii then
-    fToken:=toString
+    fToken:=Classes.toString
   else
     fToken:=toWString;
   fLastTokenStr:=fLastTokenWStr;
diff --git a/tests/test/tobject5.pp b/tests/test/tobject5.pp
new file mode 100644
index 0000000000..a50185cab6
--- /dev/null
+++ b/tests/test/tobject5.pp
@@ -0,0 +1,15 @@
+program tobject1;
+
+{$apptype console}
+{$mode objfpc}{$H+}
+var
+  Obj: TObject;
+begin
+  Obj := TObject.Create;
+  WriteLn(Obj.Equals(Obj)); // true
+  WriteLn(Obj.GetHashCode); // PtrInt(Obj)
+  WriteLn(Obj.UnitName); // System
+  WriteLn(Obj.ToString); // TObject
+  Obj.Free;
+end.
+
diff --git a/utils/fpdoc/dw_html.pp b/utils/fpdoc/dw_html.pp
index ca931faeb6..1d652ae1b2 100644
--- a/utils/fpdoc/dw_html.pp
+++ b/utils/fpdoc/dw_html.pp
@@ -113,7 +113,7 @@ type
 
     Procedure CreateAllocator; virtual;
     function ResolveLinkID(const Name: String): DOMString;
-    function ResolveLinkIDInUnit(const Name,UnitName: String): DOMString;
+    function ResolveLinkIDInUnit(const Name,AUnitName: String): DOMString;
     function ResolveLinkWithinPackage(AElement: TPasElement;
       ASubpageIndex: Integer): String;
 
@@ -794,12 +794,12 @@ end;
   - AppendHyperlink (for unresolved parse tree element links)
 }
 
-function THTMLWriter.ResolveLinkIDInUnit(const Name,UnitName: String): DOMString;
+function THTMLWriter.ResolveLinkIDInUnit(const Name,AUnitName: String): DOMString;
 
 begin
   Result:=ResolveLinkID(Name);
-  If (Result='') and (UnitName<>'')  then
-    Result:=ResolveLinkID(UnitName+'.'+Name);
+  If (Result='') and (AUnitName<>'')  then
+    Result:=ResolveLinkID(AUnitName+'.'+Name);
 end;
 
 function THTMLWriter.ResolveLinkID(const Name: String): DOMString;