X Tutup
Skip to content

Commit 6161ad7

Browse files
michaliskambimichaliskambi
committed
Extend CASTLE_LIST_METHODS_WORKAROUND to TNodeDestructionNotificationList, autotest
1 parent 7a567a2 commit 6161ad7

File tree

5 files changed

+136
-16
lines changed

5 files changed

+136
-16
lines changed

‎src/base/castleclassutils.pas‎

Lines changed: 1 addition & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -951,10 +951,7 @@ TCastleObjectList = class({$ifndef PASDOC}Contnrs.{$endif}TObjectList)
951951
procedure AddIfNotExists(Value: TObject);
952952
end;
953953

954-
{ FPC 3.2.3 on 32-bit ARM (Raspberry Pi) has wrong List.IndexOf by default
955-
(due to constref / const changes in the Generics.Collections ?), workaround. }
956-
{$if defined(FPC) and defined(VER3_2) and defined(LINUX) and defined(CPUarm)}
957-
{$define CASTLE_LIST_METHODS_WORKAROUND}
954+
{$ifdef CASTLE_LIST_METHODS_WORKAROUND}
958955
{ Note that this will make warnings that our IndexOf hides ancestor,
959956
and it seems we cannot avoid them.
960957
We cannot override or redeclare, as FPC thinks they use constref in TList,

‎src/common_includes/castleconf.inc‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -238,6 +238,12 @@
238238
{$undef GENERICS_CONSTREF}
239239
{$endif}
240240

241+
{ FPC 3.2.3 on 32-bit ARM (Raspberry Pi) has wrong List.IndexOf by default
242+
(due to constref / const changes in the Generics.Collections ?), workaround. }
243+
{$if defined(FPC) and defined(VER3_2) and defined(LINUX) and defined(CPUarm)}
244+
{$define CASTLE_LIST_METHODS_WORKAROUND}
245+
{$endif}
246+
241247
{ Define CASTLE_IOS when appropriate ----------------------------------------- }
242248

243249
{ Build tool defines CASTLE_IOS automatically.

‎src/scene/x3d/x3dnodes_destructionnotification.inc‎

Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,12 +18,27 @@
1818

1919
TNodeDestructionNotification = procedure (const Node: TX3DNode) of object;
2020

21+
{$ifdef CASTLE_LIST_METHODS_WORKAROUND}
22+
{ Note that this will make warnings that our IndexOf hides ancestor,
23+
and it seems we cannot avoid them. }
24+
{$warnings off}
25+
{$endif}
26+
2127
TNodeDestructionNotificationList = class({$ifdef FPC}specialize{$endif} TList<TNodeDestructionNotification>)
2228
public
2329
{ Call all functions. }
2430
procedure ExecuteAll(const Node: TX3DNode);
31+
32+
{$ifdef CASTLE_LIST_METHODS_WORKAROUND}
33+
function IndexOf(const Item: TNodeDestructionNotification): SizeInt;
34+
procedure Remove(const Item: TNodeDestructionNotification);
35+
{$endif}
2536
end;
2637

38+
{$ifdef CASTLE_LIST_METHODS_WORKAROUND}
39+
{$warnings on}
40+
{$endif}
41+
2742
{$endif read_interface}
2843

2944
{$ifdef read_implementation}
@@ -38,4 +53,25 @@ begin
3853
Items[I](Node);
3954
end;
4055

56+
{$ifdef CASTLE_LIST_METHODS_WORKAROUND}
57+
function TNodeDestructionNotificationList.IndexOf(const Item: TNodeDestructionNotification): SizeInt;
58+
var
59+
I: SizeInt;
60+
begin
61+
for I := 0 to Count - 1 do
62+
if SameMethods(TMethod(Item), TMethod(Items[I])) then
63+
Exit(I);
64+
Result := -1;
65+
end;
66+
67+
procedure TNodeDestructionNotificationList.Remove(const Item: TNodeDestructionNotification);
68+
var
69+
I: SizeInt;
70+
begin
71+
I := IndexOf(Item);
72+
if I <> -1 then
73+
Delete(I);
74+
end;
75+
{$endif}
76+
4177
{$endif read_implementation}

‎tests/code/testcases/testgenericscollections.pas‎

Lines changed: 18 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,9 @@
1717
{ Test Generics.Collections unit. These tests are independent from CGE. }
1818
unit TestGenericsCollections;
1919

20-
{ Needed to define GENERICS_CONSTREF on some platforms/compilers. }
20+
{ Needed to define
21+
- GENERICS_CONSTREF on some platforms/compilers.
22+
- CASTLE_LIST_METHODS_WORKAROUND on some platforms/compilers. }
2123
{$I ../../../src/common_includes/castleconf.inc}
2224

2325
interface
@@ -510,25 +512,29 @@ procedure TSomeClass.Foo(A: Integer);
510512
{$define LIST_INDEXOF_WORKAROUND}
511513
{$endif}
512514

513-
{ FPC 3.2.3 on 32-bit ARM (Raspberry Pi) has wrong List.IndexOf by default
514-
(due to constref / const changes in the Generics.Collections ?), workaround }
515-
{$if defined(FPC) and defined(VER3_2) and defined(LINUX) and defined(CPUarm)}
516-
{$define LIST_INDEXOF_WORKAROUND}
517-
{$define LIST_REMOVE_WORKAROUND}
518-
{$endif}
519-
520515
type
521516
TMyMethod = procedure (A: Integer) of object;
517+
518+
{$if defined(LIST_INDEXOF_WORKAROUND) or defined(CASTLE_LIST_METHODS_WORKAROUND)}
519+
{ Note that this will make warnings that our IndexOf hides ancestor,
520+
and it seems we cannot avoid them. }
521+
{$warnings off}
522+
{$endif}
523+
522524
TMyMethodList = class({$ifdef FPC}specialize{$endif} TList<TMyMethod>)
523-
{$ifdef LIST_INDEXOF_WORKAROUND}
525+
{$if defined(LIST_INDEXOF_WORKAROUND) or defined(CASTLE_LIST_METHODS_WORKAROUND)}
524526
function IndexOf(const M: TMyMethod): Integer;
525527
{$endif}
526-
{$ifdef LIST_REMOVE_WORKAROUND}
528+
{$ifdef CASTLE_LIST_METHODS_WORKAROUND}
527529
procedure Remove(const M: TMyMethod);
528530
{$endif}
529531
end;
530532

531-
{$ifdef LIST_INDEXOF_WORKAROUND}
533+
{$if defined(LIST_INDEXOF_WORKAROUND) or defined(CASTLE_LIST_METHODS_WORKAROUND)}
534+
{$warnings on}
535+
{$endif}
536+
537+
{$if defined(LIST_INDEXOF_WORKAROUND) or defined(CASTLE_LIST_METHODS_WORKAROUND)}
532538
function TMyMethodList.IndexOf(const M: TMyMethod): Integer;
533539
var
534540
M2: TMyMethod;
@@ -544,7 +550,7 @@ function TMyMethodList.IndexOf(const M: TMyMethod): Integer;
544550
end;
545551
{$endif}
546552

547-
{$ifdef LIST_REMOVE_WORKAROUND}
553+
{$ifdef CASTLE_LIST_METHODS_WORKAROUND}
548554
procedure TMyMethodList.Remove(const M: TMyMethod);
549555
var
550556
I: Integer;

‎tests/code/testcases/testx3dnodes.pas‎

Lines changed: 75 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -147,6 +147,7 @@ TGatheredCoordRange = record
147147
procedure TestGltfSkinnedAnimationBBox;
148148
procedure TestRouteNodesPositions;
149149
procedure TestNoFailMultiTexture;
150+
procedure TestNodeDestructionNotificationList;
150151
end;
151152

152153
implementation
@@ -3386,6 +3387,80 @@ procedure TTestX3DNodes.TestNoFailMultiTexture;
33863387
finally FreeAndNil(Root) end;
33873388
end;
33883389

3390+
type
3391+
TSomeClass = class
3392+
procedure Foo(const Node: TX3DNode);
3393+
end;
3394+
3395+
procedure TSomeClass.Foo(const Node: TX3DNode);
3396+
begin
3397+
end;
3398+
3399+
procedure TTestX3DNodes.TestNodeDestructionNotificationList;
3400+
3401+
procedure AssertMethodsEqual(const M1, M2: TNodeDestructionNotification);
3402+
begin
3403+
AssertTrue(TMethod(M1).Code = TMethod(M2).Code);
3404+
AssertTrue(TMethod(M1).Data = TMethod(M2).Data);
3405+
end;
3406+
3407+
var
3408+
List: TNodeDestructionNotificationList;
3409+
C1, C2, C3: TSomeClass;
3410+
M: TNodeDestructionNotification;
3411+
begin
3412+
C1 := TSomeClass.Create;
3413+
C2 := TSomeClass.Create;
3414+
C3 := TSomeClass.Create;
3415+
3416+
List := TNodeDestructionNotificationList.Create;
3417+
try
3418+
List.Add({$ifdef FPC}@{$endif}C1.Foo);
3419+
List.Add({$ifdef FPC}@{$endif}C2.Foo);
3420+
List.Add({$ifdef FPC}@{$endif}C2.Foo);
3421+
3422+
AssertEquals(3, List.Count);
3423+
M := {$ifdef FPC}@{$endif}C1.Foo;
3424+
AssertMethodsEqual(List[0], M);
3425+
M := {$ifdef FPC}@{$endif}C2.Foo;
3426+
AssertMethodsEqual(List[1], M);
3427+
AssertMethodsEqual(List[2], M);
3428+
3429+
List.Delete(2);
3430+
3431+
AssertEquals(2, List.Count);
3432+
M := {$ifdef FPC}@{$endif}C1.Foo;
3433+
AssertMethodsEqual(List[0], M);
3434+
M := {$ifdef FPC}@{$endif}C2.Foo;
3435+
AssertMethodsEqual(List[1], M);
3436+
3437+
AssertEquals(0, List.IndexOf({$ifdef FPC}@{$endif}C1.Foo));
3438+
AssertEquals(1, List.IndexOf({$ifdef FPC}@{$endif}C2.Foo));
3439+
3440+
// same results with M
3441+
M := {$ifdef FPC}@{$endif}C1.Foo;
3442+
AssertEquals(0, List.IndexOf(M));
3443+
M := {$ifdef FPC}@{$endif}C2.Foo;
3444+
AssertEquals(1, List.IndexOf(M));
3445+
3446+
AssertEquals(-1, List.IndexOf({$ifdef FPC}@{$endif}C3.Foo));
3447+
3448+
List.Remove({$ifdef FPC}@{$endif}C1.Foo);
3449+
AssertEquals(1, List.Count);
3450+
M := {$ifdef FPC}@{$endif}C2.Foo;
3451+
AssertMethodsEqual(List[0], M);
3452+
3453+
List.Remove({$ifdef FPC}@{$endif}C3.Foo); // does nothing, no such item
3454+
AssertEquals(1, List.Count);
3455+
M := {$ifdef FPC}@{$endif}C2.Foo;
3456+
AssertMethodsEqual(List[0], M);
3457+
finally FreeAndNil(List) end;
3458+
3459+
C1.Free;
3460+
C2.Free;
3461+
C3.Free;
3462+
end;
3463+
33893464
initialization
33903465
RegisterTest(TTestX3DNodes);
33913466
end.

0 commit comments

Comments
 (0)
X Tutup