gcc/testsuite/gnat.dg/sso/r12.adb

   1 -- { dg-do run }
   2
   3 with Init12; use Init12;
   4 with Text_IO; use Text_IO;
   5 with Dump;
   6
   7 procedure R12 is
   8
   9   function Get_Elem (A : Arr1) return Integer is
  10     Tmp : Arr1 := A;
  11   begin
  12     return Tmp(1);
  13   end;
  14
  15   procedure Set_Elem (A : access Arr1; I : Integer) is
  16     Tmp : Arr1 := A.all;
  17   begin
  18     Tmp(1) := I;
  19     A.all := Tmp;
  20   end;
  21
  22   function Get_Elem (A : Arr11) return Integer is
  23     Tmp : Arr11 := A;
  24   begin
  25     return Tmp(1,1);
  26   end;
  27
  28   procedure Set_Elem (A : access Arr11; I : Integer) is
  29     Tmp : Arr11 := A.all;
  30   begin
  31     Tmp(1,1) := I;
  32     A.all := Tmp;
  33   end;
  34
  35   function Get_Elem (A : Arr2) return Integer is
  36     Tmp : Arr2 := A;
  37   begin
  38     return Tmp(1);
  39   end;
  40
  41   procedure Set_Elem (A : access Arr2; I : Integer) is
  42     Tmp : Arr2 := A.all;
  43   begin
  44     Tmp(1) := I;
  45     A.all := Tmp;
  46   end;
  47
  48   function Get_Elem (A : Arr22) return Integer is
  49     Tmp : Arr22 := A;
  50   begin
  51     return Tmp(1,1);
  52   end;
  53
  54   procedure Set_Elem (A : access Arr22; I : Integer) is
  55     Tmp : Arr22 := A.all;
  56   begin
  57     Tmp(1,1) := I;
  58     A.all := Tmp;
  59   end;
  60
  61   A1  : aliased Arr1  := My_A1;
  62   A11 : aliased Arr11 := My_A11;
  63
  64   A2  : aliased Arr2  := My_A2;
  65   A22 : aliased Arr22 := My_A22;
  66
  67 begin
  68   Put ("A1  :");
  69   Dump (A1'Address, Arr1'Max_Size_In_Storage_Elements);
  70   New_Line;
  71   -- { dg-output "A1  : 12 00 ab 00 34 00 cd 00 56 00 ef 00.*\n" }
  72
  73   Put ("A11 :");
  74   Dump (A11'Address, Arr11'Max_Size_In_Storage_Elements);
  75   New_Line;
  76   -- { dg-output "A11 : 12 00 ab 00 34 00 cd 00 12 00 ab 00 34 00 cd 00.*\n" }
  77
  78   Put ("A2  :");
  79   Dump (A2'Address, Arr2'Max_Size_In_Storage_Elements);
  80   New_Line;
  81   -- { dg-output "A2  : 00 ab 00 12 00 cd 00 34 00 ef 00 56.*\n" }
  82
  83   Put ("A22 :");
  84   Dump (A22'Address, Arr22'Max_Size_In_Storage_Elements);
  85   New_Line;
  86   -- { dg-output "A22 : 00 ab 00 12 00 cd 00 34 00 ab 00 12 00 cd 00 34.*\n" }
  87
  88   if Get_Elem (A1) /= 16#AB0012# then
  89     raise Program_Error;
  90   end if;
  91
  92   Set_Elem (A1'Access, 16#CD0034#);
  93   if Get_Elem (A1) /= 16#CD0034# then
  94     raise Program_Error;
  95   end if;
  96
  97   if Get_Elem (A11) /= 16#AB0012# then
  98     raise Program_Error;
  99   end if;
 100
 101   Set_Elem (A11'Access, 16#CD0034#);
 102   if Get_Elem (A11) /= 16#CD0034# then
 103     raise Program_Error;
 104   end if;
 105
 106   if Get_Elem (A2) /= 16#AB0012# then
 107     raise Program_Error;
 108   end if;
 109
 110   Set_Elem (A2'Access, 16#CD0034#);
 111   if Get_Elem (A2) /= 16#CD0034# then
 112     raise Program_Error;
 113   end if;
 114
 115   if Get_Elem (A22) /= 16#AB0012# then
 116     raise Program_Error;
 117   end if;
 118
 119   Set_Elem (A22'Access, 16#CD0034#);
 120   if Get_Elem (A22) /= 16#CD0034# then
 121     raise Program_Error;
 122   end if;
 123 end;