From 427140263c028a46b0a7be37647bcedd6b8bd0e3 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 7 Jun 2007 13:04:02 +0200 Subject: [PATCH] Add new tests From-SVN: r125527 --- gcc/testsuite/gnat.dg/address_null_init.ads | 8 ++ gcc/testsuite/gnat.dg/aggr3.adb | 36 ++++++++ gcc/testsuite/gnat.dg/aggr4.adb | 27 ++++++ gcc/testsuite/gnat.dg/aggr5.ads | 7 ++ gcc/testsuite/gnat.dg/aggr6.adb | 13 +++ gcc/testsuite/gnat.dg/anon1.ads | 4 + gcc/testsuite/gnat.dg/anon2.adb | 9 ++ gcc/testsuite/gnat.dg/deques.ads | 14 ++++ gcc/testsuite/gnat.dg/equal_access.adb | 9 ++ gcc/testsuite/gnat.dg/ifaces.adb | 5 ++ gcc/testsuite/gnat.dg/ifaces.ads | 17 ++++ gcc/testsuite/gnat.dg/ref_type.adb | 10 +++ gcc/testsuite/gnat.dg/ref_type.ads | 5 ++ gcc/testsuite/gnat.dg/rep_problem2.adb | 101 +++++++++++++++++++++++ gcc/testsuite/gnat.dg/show_deques_priority.adb | 11 +++ gcc/testsuite/gnat.dg/test_address_null_init.adb | 16 ++++ gcc/testsuite/gnat.dg/test_ifaces.adb | 10 +++ 17 files changed, 302 insertions(+) create mode 100644 gcc/testsuite/gnat.dg/address_null_init.ads create mode 100644 gcc/testsuite/gnat.dg/aggr3.adb create mode 100644 gcc/testsuite/gnat.dg/aggr4.adb create mode 100644 gcc/testsuite/gnat.dg/aggr5.ads create mode 100644 gcc/testsuite/gnat.dg/aggr6.adb create mode 100644 gcc/testsuite/gnat.dg/anon1.ads create mode 100644 gcc/testsuite/gnat.dg/anon2.adb create mode 100644 gcc/testsuite/gnat.dg/deques.ads create mode 100644 gcc/testsuite/gnat.dg/equal_access.adb create mode 100644 gcc/testsuite/gnat.dg/ifaces.adb create mode 100644 gcc/testsuite/gnat.dg/ifaces.ads create mode 100644 gcc/testsuite/gnat.dg/ref_type.adb create mode 100644 gcc/testsuite/gnat.dg/ref_type.ads create mode 100644 gcc/testsuite/gnat.dg/rep_problem2.adb create mode 100644 gcc/testsuite/gnat.dg/show_deques_priority.adb create mode 100644 gcc/testsuite/gnat.dg/test_address_null_init.adb create mode 100644 gcc/testsuite/gnat.dg/test_ifaces.adb diff --git a/gcc/testsuite/gnat.dg/address_null_init.ads b/gcc/testsuite/gnat.dg/address_null_init.ads new file mode 100644 index 0000000..58c1c31 --- /dev/null +++ b/gcc/testsuite/gnat.dg/address_null_init.ads @@ -0,0 +1,8 @@ +package Address_Null_Init is + + type Acc is access Integer; + A : Acc := new Integer'(123); + B : Acc; -- Variable must be set to null (and A overwritten by null) + for B'Address use A'Address; + +end Address_Null_Init; diff --git a/gcc/testsuite/gnat.dg/aggr3.adb b/gcc/testsuite/gnat.dg/aggr3.adb new file mode 100644 index 0000000..dd6cec1 --- /dev/null +++ b/gcc/testsuite/gnat.dg/aggr3.adb @@ -0,0 +1,36 @@ +-- { dg-do run } + +with Ada.Tags; use Ada.Tags; +with Ada.Text_IO; use Ada.Text_IO; +procedure aggr3 is + package Pkg is + type Element is interface; + type Event is tagged record + V1 : Natural; + V2 : Natural; + end record; + function Create return Event; + type D_Event is new Event and Element with null record; + function Create return D_Event; + end; + package body Pkg is + function Create return Event is + Obj : Event; + begin + Obj.V1 := 0; + return Obj; + end; + function Create return D_Event is + begin + return (Event'(Create) with null record); + end; + end; + use Pkg; + procedure CW_Test (Obj : Element'Class) is + S : Constant String := Expanded_Name (Obj'Tag); + begin + null; + end; +begin + CW_Test (Create); +end; diff --git a/gcc/testsuite/gnat.dg/aggr4.adb b/gcc/testsuite/gnat.dg/aggr4.adb new file mode 100644 index 0000000..3604967 --- /dev/null +++ b/gcc/testsuite/gnat.dg/aggr4.adb @@ -0,0 +1,27 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } + +procedure aggr4 is + type Byte is range 0 .. 2**8 - 1; + for Byte'Size use 8; + + type Time is array (1 .. 3) of Byte; + + type UTC_Time is record + Values : Time; + end record; + + type Local_Time is record + Values : Time; + end record; + for Local_Time use record + Values at 0 range 1 .. 24; + end record; + + LOC : Local_Time; + UTC : UTC_Time; + +begin + UTC.Values := LOC.Values; + UTC := (Values => LOC.Values); +end; diff --git a/gcc/testsuite/gnat.dg/aggr5.ads b/gcc/testsuite/gnat.dg/aggr5.ads new file mode 100644 index 0000000..e5a0f9f --- /dev/null +++ b/gcc/testsuite/gnat.dg/aggr5.ads @@ -0,0 +1,7 @@ + +package aggr5 is + type Event is limited interface; + type Event_Access is access all Event'Class; + type Q_Action_Event is limited interface and Event; + function Build (X : integer) return Event_Access; +end aggr5; diff --git a/gcc/testsuite/gnat.dg/aggr6.adb b/gcc/testsuite/gnat.dg/aggr6.adb new file mode 100644 index 0000000..89f9702 --- /dev/null +++ b/gcc/testsuite/gnat.dg/aggr6.adb @@ -0,0 +1,13 @@ +-- { dg-do compile } + +with aggr5; +procedure aggr6 is + procedure Block is + Wrapper : aliased aggr5.Q_Action_Event'Class + := aggr5.Q_Action_Event'Class (aggr5.Build (0)); + begin + null; + end; +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/anon1.ads b/gcc/testsuite/gnat.dg/anon1.ads new file mode 100644 index 0000000..d3aaa56 --- /dev/null +++ b/gcc/testsuite/gnat.dg/anon1.ads @@ -0,0 +1,4 @@ + +package anon1 is + function F return access Integer; +end anon1; diff --git a/gcc/testsuite/gnat.dg/anon2.adb b/gcc/testsuite/gnat.dg/anon2.adb new file mode 100644 index 0000000..c114fcc --- /dev/null +++ b/gcc/testsuite/gnat.dg/anon2.adb @@ -0,0 +1,9 @@ +-- { dg-do compile } + +with anon1; +procedure anon2 is +begin + if anon1.F /= null then + null; + end if; +end anon2; diff --git a/gcc/testsuite/gnat.dg/deques.ads b/gcc/testsuite/gnat.dg/deques.ads new file mode 100644 index 0000000..9e74897 --- /dev/null +++ b/gcc/testsuite/gnat.dg/deques.ads @@ -0,0 +1,14 @@ +package Deques is + + type Deque (<>) is tagged limited private; + function Create return Deque; + procedure Pop (D : access Deque); + + type Sequence is limited interface; + type P_Deque is new Deque and Sequence with private; + function Create return P_Deque; + +private + type Deque is tagged limited null record; + type P_Deque is new Deque and Sequence with null record; +end Deques; diff --git a/gcc/testsuite/gnat.dg/equal_access.adb b/gcc/testsuite/gnat.dg/equal_access.adb new file mode 100644 index 0000000..699c4da --- /dev/null +++ b/gcc/testsuite/gnat.dg/equal_access.adb @@ -0,0 +1,9 @@ +-- { dg-do compile } + +procedure equal_access is + PA, PB : access procedure := null; +begin + if PA /= PB then + null; + end if; +end; diff --git a/gcc/testsuite/gnat.dg/ifaces.adb b/gcc/testsuite/gnat.dg/ifaces.adb new file mode 100644 index 0000000..2251379 --- /dev/null +++ b/gcc/testsuite/gnat.dg/ifaces.adb @@ -0,0 +1,5 @@ +with Text_IO; use Text_IO; +package body Ifaces is + procedure op1 (this : Root) is begin null; end; + procedure op2 (this : DT) is begin null; end; +end; diff --git a/gcc/testsuite/gnat.dg/ifaces.ads b/gcc/testsuite/gnat.dg/ifaces.ads new file mode 100644 index 0000000..598c0a9 --- /dev/null +++ b/gcc/testsuite/gnat.dg/ifaces.ads @@ -0,0 +1,17 @@ + +package Ifaces is + type Iface_1 is interface; + procedure op1(this : Iface_1) is abstract; +-- + type Iface_2 is interface; + procedure op2 (this : Iface_2) is abstract; +-- + type Root is new Iface_1 with record + m_name : String(1..4); + end record; +-- + procedure op1 (this : Root); +-- + type DT is new Root and Iface_2 with null record; + procedure op2 (this : DT); +end; diff --git a/gcc/testsuite/gnat.dg/ref_type.adb b/gcc/testsuite/gnat.dg/ref_type.adb new file mode 100644 index 0000000..4cead90 --- /dev/null +++ b/gcc/testsuite/gnat.dg/ref_type.adb @@ -0,0 +1,10 @@ + +-- { dg-do compile } + +package body ref_type is + type T is tagged null record; + procedure Print (X : T) is + begin + null; + end; +end ref_type; diff --git a/gcc/testsuite/gnat.dg/ref_type.ads b/gcc/testsuite/gnat.dg/ref_type.ads new file mode 100644 index 0000000..021ca72 --- /dev/null +++ b/gcc/testsuite/gnat.dg/ref_type.ads @@ -0,0 +1,5 @@ +package ref_type is +private + type T is tagged; + procedure Print (X : T); +end ref_type; diff --git a/gcc/testsuite/gnat.dg/rep_problem2.adb b/gcc/testsuite/gnat.dg/rep_problem2.adb new file mode 100644 index 0000000..5bd69b8 --- /dev/null +++ b/gcc/testsuite/gnat.dg/rep_problem2.adb @@ -0,0 +1,101 @@ +-- { dg-do compile } + +with Ada.Text_IO; use Ada.Text_IO; + +procedure Rep_Problem2 is + + type Int_16 is range 0 .. 65535; + for Int_16'Size use 16; + + ---------------------------------------------- + + type Rec_A is + record + Int_1 : Int_16; + Int_2 : Int_16; + Int_3 : Int_16; + Int_4 : Int_16; + end record; + + + for Rec_A use record + Int_1 at 0 range 0 .. 15; + Int_2 at 2 range 0 .. 15; + Int_3 at 4 range 0 .. 15; + Int_4 at 6 range 0 .. 15; + end record; + + Rec_A_Size : constant := 4 * 16; + + for Rec_A'Size use Rec_A_Size; + + ---------------------------------------------- + + type Rec_B_Version_1 is + record + Rec_1 : Rec_A; + Rec_2 : Rec_A; + Int_1 : Int_16; + end record; + + for Rec_B_Version_1 use record + Rec_1 at 0 range 0 .. 63; + Rec_2 at 8 range 0 .. 63; + Int_1 at 16 range 0 .. 15; + end record; + + Rec_B_Size : constant := 2 * Rec_A_Size + 16; + + for Rec_B_Version_1'Size use Rec_B_Size; + for Rec_B_Version_1'Alignment use 2; + + ---------------------------------------------- + + type Rec_B_Version_2 is + record + Int_1 : Int_16; + Rec_1 : Rec_A; + Rec_2 : Rec_A; + end record; + + for Rec_B_Version_2 use record + Int_1 at 0 range 0 .. 15; + Rec_1 at 2 range 0 .. 63; + Rec_2 at 10 range 0 .. 63; + end record; + + for Rec_B_Version_2'Size use Rec_B_Size; + + ---------------------------------------------- + + Arr_A_Length : constant := 2; + Arr_A_Size : constant := Arr_A_Length * Rec_B_Size; + + type Arr_A_Version_1 is array (1 .. Arr_A_Length) of Rec_B_Version_1; + type Arr_A_Version_2 is array (1 .. Arr_A_Length) of Rec_B_Version_2; + + pragma Pack (Arr_A_Version_1); + pragma Pack (Arr_A_Version_2); + + for Arr_A_Version_1'Size use Arr_A_Size; + for Arr_A_Version_2'Size use Arr_A_Size; + + ---------------------------------------------- + +begin + -- Put_Line ("Arr_A_Size =" & Arr_A_Size'Img); + + if Arr_A_Version_1'Size /= Arr_A_Size then + Ada.Text_IO.Put_Line + ("Version 1 Size mismatch! " & + "Arr_A_Version_1'Size =" & Arr_A_Version_1'Size'Img); + end if; + + if Arr_A_Version_2'Size /= Arr_A_Size then + Ada.Text_IO.Put_Line + ("Version 2 Size mismatch! " & + "Arr_A_Version_2'Size =" & Arr_A_Version_2'Size'Img); + + end if; + +end Rep_Problem2; diff --git a/gcc/testsuite/gnat.dg/show_deques_priority.adb b/gcc/testsuite/gnat.dg/show_deques_priority.adb new file mode 100644 index 0000000..614e825 --- /dev/null +++ b/gcc/testsuite/gnat.dg/show_deques_priority.adb @@ -0,0 +1,11 @@ +-- { dg-do compile } + +with Deques; +procedure Show_Deques_Priority is + use Deques; + + PD : aliased P_Deque := Create; + +begin + PD.Pop; +end Show_Deques_Priority; diff --git a/gcc/testsuite/gnat.dg/test_address_null_init.adb b/gcc/testsuite/gnat.dg/test_address_null_init.adb new file mode 100644 index 0000000..18824d6 --- /dev/null +++ b/gcc/testsuite/gnat.dg/test_address_null_init.adb @@ -0,0 +1,16 @@ +-- { dg-do run } +-- { dg-options "-gnatws" } + +with Address_Null_Init; use Address_Null_Init; +with Ada.Text_IO; use Ada.Text_IO; + +procedure Test_Address_Null_Init is +begin + if B /= null then + Put_Line ("ERROR: B was not default initialized to null!"); + end if; + + if A /= null then + Put_Line ("ERROR: A was not reinitialized to null!"); + end if; +end Test_Address_Null_Init; diff --git a/gcc/testsuite/gnat.dg/test_ifaces.adb b/gcc/testsuite/gnat.dg/test_ifaces.adb new file mode 100644 index 0000000..5fca137 --- /dev/null +++ b/gcc/testsuite/gnat.dg/test_ifaces.adb @@ -0,0 +1,10 @@ +-- { dg-do run } + +with Ifaces; use Ifaces; +procedure test_ifaces is + view2 : access Iface_2'Class; + obj : aliased DT := (m_name => "Abdu"); +begin + view2 := Iface_2'Class(obj)'Access; + view2.all.op2; +end; -- 2.7.4