gcc/testsuite/gnat.dg/strub_renm2.adb

   1 --  { dg-do compile }
   2 --  { dg-options "-fstrub=strict -fdump-ipa-strub" }
   3 --  { dg-require-effective-target strub }
   4
   5 procedure Strub_Renm2 is
   6    V : Integer := 0;
   7    pragma Machine_Attribute (V, "strub");
   8
   9    procedure P (X : Integer);
  10    pragma Machine_Attribute (P, "strub", "at-calls");
  11
  12    function F return Integer;
  13
  14    procedure Q (X : Integer) renames P;
  15    pragma Machine_Attribute (Q, "strub", "at-calls");
  16
  17    type T is access function return Integer;
  18
  19    type TC is access function return Integer;
  20    pragma Machine_Attribute (TC, "strub", "callable");
  21
  22    FCptr : constant TC := TC (T'(F'Access));
  23
  24    function G return Integer renames FCptr.all;
  25    pragma Machine_Attribute (G, "strub", "callable");
  26
  27    procedure P (X : Integer) is null;
  28    function F return Integer is (0);
  29
  30 begin
  31    P (F);  -- { dg-error "calling non-.strub." }
  32    Q (G);  -- ok, G is callable.
  33 end Strub_Renm2;