gcc/testsuite/gnat.dg/strub_disp1.adb

   1 --  { dg-do compile }
   2 --  { dg-options "-fdump-ipa-strub" }
   3 --  { dg-require-effective-target strub }
   4
   5 -- Check that at-calls dispatching calls are transformed.
   6
   7 procedure Strub_Disp1 is
   8    package Foo is
   9       type A is tagged null record;
  10
  11       procedure P (I : Integer; X : A);
  12       pragma Machine_Attribute (P, "strub", "at-calls");
  13
  14       function F (X : access A) return Integer;
  15       pragma Machine_Attribute (F, "strub", "at-calls");
  16
  17       type B is new A with null record;
  18
  19       overriding
  20       procedure P (I : Integer; X : B);
  21       pragma Machine_Attribute (P, "strub", "at-calls");
  22
  23       overriding
  24       function F (X : access B) return Integer;
  25       pragma Machine_Attribute (F, "strub", "at-calls");
  26
  27    end Foo;
  28
  29    package body Foo is
  30       procedure P (I : Integer; X : A) is
  31       begin
  32          null;
  33       end;
  34
  35       function F (X : access A) return Integer is (0);
  36
  37       overriding
  38       procedure P (I : Integer; X : B) is
  39       begin
  40          P (I, A (X)); -- strub-at-calls non-dispatching call
  41       end;
  42
  43       overriding
  44       function F (X : access B) return Integer is (1);
  45    end Foo;
  46
  47    use Foo;
  48
  49    procedure Q (X : A'Class) is
  50    begin
  51       P (-1, X); -- strub-at-calls dispatching call.
  52    end;
  53
  54    XA : aliased A;
  55    XB : aliased B;
  56    I : Integer := 0;
  57    XC : access A'Class;
  58 begin
  59    Q (XA);
  60    Q (XB);
  61
  62    I := I + F (XA'Access); -- strub-at-calls non-dispatching call
  63    I := I + F (XB'Access); -- strub-at-calls non-dispatching call
  64
  65    XC := XA'Access;
  66    I := I + F (XC); -- strub-at-calls dispatching call.
  67
  68    XC := XB'Access;
  69    I := I + F (XC); -- strub-at-calls dispatching call.
  70 end Strub_Disp1;
  71
  72 --  { dg-final { scan-ipa-dump-times "\[(\]strub \[(\]at-calls\[)\]\[)\]" 4 "strub" } }
  73
  74 --  Count the strub-at-calls non-dispatching calls
  75 --  (+ 2 each, for the matching prototypes)
  76 --  { dg-final { scan-ipa-dump-times "foo\.p \[(\]\[^\n\]*watermark" 3 "strub" } }
  77 --  { dg-final { scan-ipa-dump-times "foo\.f \[(\]\[^\n\]*watermark" 4 "strub" } }
  78
  79 --  Count the strub-at-calls dispatching calls.
  80 --  { dg-final { scan-ipa-dump-times "_\[0-9\]* \[(\]\[^\n\]*watermark" 3 "strub" } }