Просмотр исходного кода

Fix for Mantis #25132

defcmp.pas, objectdef_is_related:
  * use "equal_defs" instead of "=", as the former also handles equivalence of specializations

+ added test

git-svn-id: trunk@25848 -
svenbarth 11 лет назад
Родитель
Сommit
c077adf499
4 измененных файлов с 98 добавлено и 1 удалено
  1. 2 0
      .gitattributes
  2. 1 1
      compiler/defcmp.pas
  3. 66 0
      tests/webtbs/tw25132.pp
  4. 29 0
      tests/webtbs/uw25132.pp

+ 2 - 0
.gitattributes

@@ -13624,6 +13624,7 @@ tests/webtbs/tw25059.pp svneol=native#text/pascal
 tests/webtbs/tw25077.pp svneol=native#text/pascal
 tests/webtbs/tw25081.pp svneol=native#text/pascal
 tests/webtbs/tw25101.pp svneol=native#text/pascal
+tests/webtbs/tw25132.pp svneol=native#text/pascal
 tests/webtbs/tw2514.pp svneol=native#text/plain
 tests/webtbs/tw25198.pp svneol=native#text/plain
 tests/webtbs/tw25210.pp svneol=native#text/pascal
@@ -14404,6 +14405,7 @@ tests/webtbs/uw25054b.pp svneol=native#text/pascal
 tests/webtbs/uw25059.pp svneol=native#text/pascal
 tests/webtbs/uw25059.test.pp svneol=native#text/pascal
 tests/webtbs/uw25059.withdot.pp svneol=native#text/pascal
+tests/webtbs/uw25132.pp svneol=native#text/pascal
 tests/webtbs/uw2706a.pp svneol=native#text/plain
 tests/webtbs/uw2706b.pp svneol=native#text/plain
 tests/webtbs/uw2731.pp svneol=native#text/plain

+ 1 - 1
compiler/defcmp.pas

@@ -2336,7 +2336,7 @@ implementation
         hp:=realself.childof;
         while assigned(hp) do
           begin
-             if hp=otherdef then
+             if equal_defs(hp,otherdef) then
                begin
                   result:=true;
                   exit;

+ 66 - 0
tests/webtbs/tw25132.pp

@@ -0,0 +1,66 @@
+program tw25132;
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+
+uses
+  uw25132;
+
+type
+  TAnotherIterator = class(TIterator<TObject>)
+  public
+    function    GetValue(): Integer; override;
+  end;
+  
+  TCollection = class(TObject)
+  private
+    function    CreateAnotherIterator(): TIterator<TObject>; virtual;
+    function    CreateIterator(): TIterator<TObject>; virtual;
+  end;
+
+{ TAnotherIterator }
+
+function TAnotherIterator.GetValue(): Integer; 
+begin
+  Result := 2;
+end;
+  
+{ TCollection}  
+  
+function TCollection.CreateAnotherIterator(): TIterator<TObject>;
+begin
+  Result := TAnotherIterator.Create();
+end;
+
+function TCollection.CreateIterator(): TIterator<TObject>;
+begin
+  Result := TCollectionIterator.Create();
+end;
+
+var
+  CollectionIterator: TCollectionIterator;
+  AnotherIterator:    TAnotherIterator;
+begin
+  CollectionIterator := TCollectionIterator.Create();
+  AnotherIterator    := TAnotherIterator.Create();
+
+  if CollectionIterator.GetValue() = 1 then
+    WriteLn('Collection iterator: OK')
+  else
+  begin
+    WriteLn('Collection iterator: FAILED');
+    Halt(1);
+  end;
+  
+  if AnotherIterator.GetValue() = 2 then
+    WriteLn('Another iterator: OK')
+  else
+  begin
+    WriteLn('Another iterator: FAILED');  
+    Halt(1);
+  end;
+  
+  CollectionIterator.Free();
+  AnotherIterator.Free();
+end.

+ 29 - 0
tests/webtbs/uw25132.pp

@@ -0,0 +1,29 @@
+unit uw25132;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+interface
+
+type
+  TIterator<TElement> = class(TObject)
+  public
+    function    GetValue(): Integer; virtual; abstract;
+  end;
+
+  TCollectionIterator = class(TIterator<TObject>)
+  public  
+    function    GetValue(): Integer; override;
+  end;
+
+implementation
+
+{ TCollectionIterator }
+
+function TCollectionIterator.GetValue(): Integer; 
+begin
+  Result := 1;
+end;
+
+end.