mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 06:29:32 +02:00
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 -
This commit is contained in:
parent
798bb91e90
commit
c077adf499
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -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
|
||||
|
@ -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
tests/webtbs/tw25132.pp
Normal file
66
tests/webtbs/tw25132.pp
Normal file
@ -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
tests/webtbs/uw25132.pp
Normal file
29
tests/webtbs/uw25132.pp
Normal file
@ -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.
|
Loading…
Reference in New Issue
Block a user