Browse Source

* tobject.unitname and tobject.tostring have to return an ansistring instead
of a shortstring (mantis #15693)
* changed tobject5 so it checks whether the return values are correct

git-svn-id: trunk@14869 -

Jonas Maebe 15 years ago
parent
commit
870edaf916
5 changed files with 28 additions and 7 deletions
  1. 1 0
      .gitattributes
  2. 2 2
      rtl/inc/objpas.inc
  3. 2 2
      rtl/inc/objpash.inc
  4. 6 3
      tests/test/tobject5.pp
  5. 17 0
      tests/webtbs/tw15693.pp

+ 1 - 0
.gitattributes

@@ -10276,6 +10276,7 @@ tests/webtbs/tw15530.pp svneol=native#text/pascal
 tests/webtbs/tw15607.pp svneol=native#text/plain
 tests/webtbs/tw15619.pp svneol=native#text/plain
 tests/webtbs/tw1567.pp svneol=native#text/plain
+tests/webtbs/tw15693.pp svneol=native#text/plain
 tests/webtbs/tw1573.pp svneol=native#text/plain
 tests/webtbs/tw1592.pp svneol=native#text/plain
 tests/webtbs/tw1617.pp svneol=native#text/plain

+ 2 - 2
rtl/inc/objpas.inc

@@ -754,7 +754,7 @@
           getinterfacetable:=PVmt(Self)^.vIntfTable;
         end;
 
-      class function TObject.UnitName : string;
+      class function TObject.UnitName : ansistring;
         type
           // from the typinfo unit
           TClassTypeInfo = {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
@@ -791,7 +791,7 @@
           result:=PtrInt(Self);
         end;
 
-      function TObject.ToString: string;
+      function TObject.ToString: ansistring;
         begin
           result:=ClassName;
         end;

+ 2 - 2
rtl/inc/objpash.inc

@@ -234,10 +234,10 @@
           class function GetInterfaceTable : pinterfacetable;
 
           { new since Delphi 2009 }
-          class function UnitName : string;
+          class function UnitName : ansistring;
           function Equals(Obj: TObject) : boolean;virtual;
           function GetHashCode: PtrInt;virtual;
-          function ToString: string;virtual;
+          function ToString: ansistring;virtual;
        end;
 
        IUnknown = interface

+ 6 - 3
tests/test/tobject5.pp

@@ -6,10 +6,13 @@ var
   Obj: TObject;
 begin
   Obj := TObject.Create;
-  WriteLn(Obj.Equals(Obj)); // true
+  if not Obj.Equals(Obj) then
+    halt(1); // true
   WriteLn(Obj.GetHashCode); // PtrInt(Obj)
-  WriteLn(Obj.UnitName); // System
-  WriteLn(Obj.ToString); // TObject
+  if Obj.UnitName<>'System' then
+    halt(2); // System
+  if Obj.ToString<>'TObject' then
+    halt(3); // TObject
   Obj.Free;
 end.
 

+ 17 - 0
tests/webtbs/tw15693.pp

@@ -0,0 +1,17 @@
+{ %norun }
+
+{$mode objfpc}
+{$h+}
+
+type
+  TMyClass = class
+    function ToString: String; override;
+  end;
+
+function TMyClass.ToString: String;
+begin
+  Result:=inherited;
+end;
+
+begin
+end.