Kaynağa Gözat

tests: tppu: change indirectly used method

mattias 15 saat önce
ebeveyn
işleme
6a6e7bcb85

+ 11 - 0
tests/tppu/ancestorchange1/ancestorchange1_ant.pas

@@ -0,0 +1,11 @@
+unit ancestorchange1_ant;
+
+{$mode objfpc}
+
+interface
+
+uses ancestorchange1_bird;
+
+implementation
+
+end.

+ 25 - 0
tests/tppu/ancestorchange1/ancestorchange1_bird.pas

@@ -0,0 +1,25 @@
+unit ancestorchange1_bird;
+
+{$mode objfpc}
+
+interface
+
+uses ancestorchange1_cat;
+
+type
+
+  { TBird }
+
+  TBird	=  class(TCat)
+  public
+    function Fly(w: word): integer;
+  end;		
+
+implementation
+
+function TBird.Fly(w: word): integer;
+begin
+   Result:=Swoop(w);
+end;
+
+end.

+ 15 - 0
tests/tppu/ancestorchange1/ancestorchange1_cat.pas

@@ -0,0 +1,15 @@
+unit ancestorchange1_cat;
+
+{$mode objfpc}
+
+interface
+
+uses ancestorchange1_eagle;
+
+type
+  TCat	=  class(TEagle)
+  end;
+
+implementation
+
+end.

+ 25 - 0
tests/tppu/ancestorchange1/src1/ancestorchange1_eagle.pas

@@ -0,0 +1,25 @@
+unit ancestorchange1_eagle;
+
+{$mode objfpc}
+
+interface
+
+type
+
+  { TEagle }
+
+  TEagle	=  class
+  public
+    function Swoop(w: word): word;
+  end;		
+
+implementation
+
+{ TEagle }
+
+function TEagle.Swoop(w: word): word;
+begin
+  Result:=2*w;
+end;
+
+end.

+ 28 - 0
tests/tppu/ancestorchange1/src2/ancestorchange1_eagle.pas

@@ -0,0 +1,28 @@
+unit ancestorchange1_eagle;
+
+{$mode objfpc}
+
+interface
+
+type
+
+  { TEagle }
+
+  TEagle = class
+  public
+    // 16th Feb 2026 fpc's indirect_crc does not always change when the parameter type changes,
+    // as tobjectdef only stores a ppu index.
+    // For this test change the modifier:
+    function Swoop(const w: word): word;
+  end;		
+
+implementation
+
+{ TEagle }
+
+function TEagle.Swoop(const w: word): word;
+begin
+  Result:=2*w;
+end;
+
+end.

+ 41 - 0
tests/tppu/tcrecompile.pas

@@ -58,6 +58,11 @@ type
     procedure TestImplInline_Bug41291; // program plus 3 cycles
     procedure TestImplInline3; // program + 2 units cycle, impl inline, implementation changed
 
+    // inherited
+    procedure TestAncestor_ChangeInheritedMethod; // changing inherited method in an indirectly used unit
+    // ToDo: TestAncestor_ChangeInheritedMethodParamType; // changing inherited method para type in an indirectly used unit
+    //         the indirect_crc does not yet support this. 16th Feb 2026
+
     // generics
     procedure TestGeneric_IndirectUses; // specialization of an inherited class in an indirectly used unit
   end;
@@ -609,6 +614,42 @@ begin
   CheckCompiled(['implinline3_prg.pas','implinline3_ant.pas','implinline3_bird.pas']);
 end;
 
+procedure TTestRecompile.TestAncestor_ChangeInheritedMethod;
+// ant->bird->cat->eagle, change method in eagle used by bird
+var
+  Dir: String;
+begin
+  Dir:='ancestorchange1';
+  UnitPath:=Dir+';'+Dir+PathDelim+'src1';
+  OutDir:=Dir+PathDelim+'ppus';
+  MainSrc:=Dir+PathDelim+'ancestorchange1_ant.pas';
+  MakeDateDiffer(
+    Dir+PathDelim+'src1'+PathDelim+'ancestorchange1_eagle.pas',
+    Dir+PathDelim+'src2'+PathDelim+'ancestorchange1_eagle.pas');
+
+  Step:='First compile';
+  CleanOutputDir;
+  Compile;
+  CheckCompiled(['ancestorchange1_ant.pas','ancestorchange1_bird.pas','ancestorchange1_cat.pas',
+    'ancestorchange1_eagle.pas']);
+
+  Step:='Second compile';
+  UnitPath:=Dir+';'+Dir+PathDelim+'src2';
+  Compile;
+  {$IFDEF EnableCTaskPPU}
+  // the main src is always compiled, cat intf class TCat changed, so bird and ant are recompiled
+  CheckCompiled(['ancestorchange1_ant.pas','ancestorchange1_bird.pas','ancestorchange1_cat.pas',
+    'ancestorchange1_eagle.pas']);
+  {$ELSE}
+  // the main src is always compiled,
+  // cat changed, so bird must be recompiled as well. bird should get the same CRCs.
+  // finally even though ant does ant directly use cat, ant specializes the changed generic
+  //   function from cat, so ant must be recompiled as well.
+  CheckCompiled(['ancestorchange1_ant.pas','ancestorchange1_bird.pas','ancestorchange1_cat.pas',
+    'ancestorchange1_eagle.pas']);
+  {$ENDIF}
+end;
+
 procedure TTestRecompile.TestGeneric_IndirectUses;
 // prog->ant.impl->bird->cat, ant specializes cat, change the generic func of cat
 var