diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/gnat.dg')
-rw-r--r-- | gcc-4.9/gcc/testsuite/gnat.dg/entry_queues2.adb | 45 | ||||
-rw-r--r-- | gcc-4.9/gcc/testsuite/gnat.dg/opt41.adb | 15 | ||||
-rw-r--r-- | gcc-4.9/gcc/testsuite/gnat.dg/opt41_pkg.adb | 53 | ||||
-rw-r--r-- | gcc-4.9/gcc/testsuite/gnat.dg/opt41_pkg.ads | 28 | ||||
-rw-r--r-- | gcc-4.9/gcc/testsuite/gnat.dg/opt45.adb | 38 | ||||
-rw-r--r-- | gcc-4.9/gcc/testsuite/gnat.dg/opt47.adb | 31 |
6 files changed, 210 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/gnat.dg/entry_queues2.adb b/gcc-4.9/gcc/testsuite/gnat.dg/entry_queues2.adb new file mode 100644 index 0000000..a1445ce --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gnat.dg/entry_queues2.adb @@ -0,0 +1,45 @@ +-- { dg-do compile } + +procedure Entry_Queues2 is + + F1 : Integer := 17; + + generic + type T is limited private; + procedure Check; + + procedure Check is + begin + declare + type Poe is new T; + begin + declare + type Arr is array (1 .. 2) of Poe; + X : Arr; + pragma Unreferenced (X); + begin + null; + end; + end; + end; + +begin + + declare + protected type Poe (D3 : Integer := F1) is + entry E (D3 .. F1); -- F1 evaluated + end Poe; + protected body Poe is + entry E (for I in D3 .. F1) when True is + begin + null; + end E; + end Poe; + + procedure Chk is new Check (Poe); + + begin + Chk; + end; + +end; diff --git a/gcc-4.9/gcc/testsuite/gnat.dg/opt41.adb b/gcc-4.9/gcc/testsuite/gnat.dg/opt41.adb new file mode 100644 index 0000000..2166043 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gnat.dg/opt41.adb @@ -0,0 +1,15 @@ +-- { dg-do run } +-- { dg-options "-Os" } + +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; +with Opt41_Pkg; use Opt41_Pkg; + +procedure Opt41 is + R : Rec := (Five, To_Unbounded_String ("CONFIG")); + SP : String_Access := new String'(To_String (Rec_Write (R))); + RP : Rec_Ptr := new Rec'(Rec_Read (SP)); +begin + if RP.D /= R.D then + raise Program_Error; + end if; +end; diff --git a/gcc-4.9/gcc/testsuite/gnat.dg/opt41_pkg.adb b/gcc-4.9/gcc/testsuite/gnat.dg/opt41_pkg.adb new file mode 100644 index 0000000..c43c1bf --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gnat.dg/opt41_pkg.adb @@ -0,0 +1,53 @@ +with Ada.Streams; use Ada.Streams;
+
+package body Opt41_Pkg is
+
+ type Wstream is new Root_Stream_Type with record
+ S : Unbounded_String;
+ end record;
+
+ procedure Read (Stream : in out Wstream;
+ Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset) is null;
+
+ procedure Write (Stream : in out Wstream; Item : Stream_Element_Array) is
+ begin
+ for J in Item'Range loop
+ Append (Stream.S, Character'Val (Item (J)));
+ end loop;
+ end Write;
+
+ function Rec_Write (R : Rec) return Unbounded_String is
+ S : aliased Wstream;
+ begin
+ Rec'Output (S'Access, R);
+ return S.S;
+ end Rec_Write;
+
+ type Rstream is new Root_Stream_Type with record
+ S : String_Access;
+ Idx : Integer := 1;
+ end record;
+
+ procedure Write (Stream : in out Rstream; Item : Stream_Element_Array) is null;
+
+ procedure Read (Stream : in out Rstream;
+ Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset) is
+ begin
+ Last := Stream_Element_Offset'Min
+ (Item'Last, Item'First + Stream_Element_Offset (Stream.S'Last - Stream.Idx));
+ for I in Item'First .. Last loop
+ Item (I) := Stream_Element (Character'Pos (Stream.S (Stream.Idx)));
+ Stream.Idx := Stream.Idx + 1;
+ end loop;
+ end Read;
+
+ function Rec_Read (Str : String_Access) return Rec is
+ S : aliased Rstream;
+ begin
+ S.S := Str;
+ return Rec'Input (S'Access);
+ end Rec_Read;
+
+end Opt41_Pkg;
diff --git a/gcc-4.9/gcc/testsuite/gnat.dg/opt41_pkg.ads b/gcc-4.9/gcc/testsuite/gnat.dg/opt41_pkg.ads new file mode 100644 index 0000000..e73bc93 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gnat.dg/opt41_pkg.ads @@ -0,0 +1,28 @@ +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+
+package Opt41_Pkg is
+
+ type Enum is (One, Two, Three, Four, Five, Six);
+
+ type Rec (D : Enum) is record
+ case D is
+ when One =>
+ I : Integer;
+ when Two | Five | Six =>
+ S : Unbounded_String;
+ case D is
+ when Two => B : Boolean;
+ when others => null;
+ end case;
+ when others =>
+ null;
+ end case;
+ end record;
+
+ type Rec_Ptr is access all Rec;
+
+ function Rec_Write (R : Rec) return Unbounded_String;
+
+ function Rec_Read (Str : String_Access) return Rec;
+
+end Opt41_Pkg;
diff --git a/gcc-4.9/gcc/testsuite/gnat.dg/opt45.adb b/gcc-4.9/gcc/testsuite/gnat.dg/opt45.adb new file mode 100644 index 0000000..f75e46e --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gnat.dg/opt45.adb @@ -0,0 +1,38 @@ +-- { dg-do compile }
+-- { dg-options "-O3" }
+
+procedure Opt45 is
+
+ type Index_T is mod 2 ** 32;
+ for Index_T'Size use 32;
+ for Index_T'Alignment use 1;
+
+ type Array_T is array (Index_T range <>) of Natural;
+ type Array_Ptr_T is access all Array_T;
+
+ My_Array_1 : aliased Array_T := (1, 2);
+ My_Array_2 : aliased Array_T := (3, 4);
+
+ Array_Ptr : Array_Ptr_T := null;
+ Index : Index_T := Index_T'First;
+
+ My_Value : Natural := Natural'First;
+
+ procedure Proc (Selection : Positive) is
+ begin
+ if Selection = 1 then
+ Array_Ptr := My_Array_1'Access;
+ Index := My_Array_1'First;
+ else
+ Array_Ptr := My_Array_2'Access;
+ Index := My_Array_2'First;
+ end if;
+
+ if My_Value = Natural'First then
+ My_Value := Array_Ptr.all (Index);
+ end if;
+ end;
+
+begin
+ Proc (2);
+end;
diff --git a/gcc-4.9/gcc/testsuite/gnat.dg/opt47.adb b/gcc-4.9/gcc/testsuite/gnat.dg/opt47.adb new file mode 100644 index 0000000..cfe44eb --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gnat.dg/opt47.adb @@ -0,0 +1,31 @@ +-- { dg-do run { target i?86-*-* x86_64-*-* alpha*-*-* ia64-*-* } } +-- { dg-options "-O2" } + +with Ada.Characters.Handling; use Ada.Characters.Handling; +with Interfaces; use Interfaces; +with Ada.Unchecked_Conversion; + +procedure Opt47 is + + subtype String4 is String (1 .. 4); + function To_String4 is new Ada.Unchecked_Conversion (Unsigned_32, String4); + type Arr is array (Integer range <>) of Unsigned_32; + Leaf : Arr (1 .. 4) := (1349478766, 1948272498, 1702436946, 1702061409); + Value : Unsigned_32; + Result : String (1 .. 32); + Last : Integer := 0; + +begin + for I in 1 .. 4 loop + Value := Leaf (I); + for J in reverse String4'Range loop + if Is_Graphic (To_String4 (Value)(J)) then + Last := Last + 1; + Result (Last) := To_String4 (Value)(J); + end if; + end loop; + end loop; + if Result (1) /= 'P' then + raise Program_Error; + end if; +end; |