From a8bed793ad88a70e251208b86f20f230a5c07fa8 Mon Sep 17 00:00:00 2001 From: charlet Date: Wed, 6 Jun 2007 10:54:25 +0000 Subject: [PATCH] Add new tests git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@125480 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/testsuite/gnat.dg/addr1.adb | 17 ++++++++++++++ gcc/testsuite/gnat.dg/addr1.ads | 5 ++++ gcc/testsuite/gnat.dg/array1.adb | 32 +++++++++++++++++++++++++ gcc/testsuite/gnat.dg/array1.ads | 9 +++++++ gcc/testsuite/gnat.dg/array2.ads | 8 +++++++ gcc/testsuite/gnat.dg/conv_bug.adb | 30 +++++++++++++++++++++++ gcc/testsuite/gnat.dg/discr1.ads | 25 ++++++++++++++++++++ gcc/testsuite/gnat.dg/discr2.adb | 22 +++++++++++++++++ gcc/testsuite/gnat.dg/discr2.ads | 5 ++++ gcc/testsuite/gnat.dg/discr3.ads | 11 +++++++++ gcc/testsuite/gnat.dg/elab1.ads | 23 ++++++++++++++++++ gcc/testsuite/gnat.dg/elab2.adb | 10 ++++++++ gcc/testsuite/gnat.dg/expect1.adb | 15 ++++++++++++ gcc/testsuite/gnat.dg/socket1.adb | 14 +++++++++++ gcc/testsuite/gnat.dg/specs/constructor.ads | 13 ++++++++++ gcc/testsuite/gnat.dg/specs/preelab.ads | 9 +++++++ gcc/testsuite/gnat.dg/specs/uc1.ads | 21 +++++++++++++++++ gcc/testsuite/gnat.dg/test_enum_io.adb | 33 ++++++++++++++++++++++++++ gcc/testsuite/gnat.dg/test_fixed_io.adb | 34 +++++++++++++++++++++++++++ gcc/testsuite/gnat.dg/test_unknown_discrs.adb | 31 ++++++++++++++++++++++++ gcc/testsuite/gnat.dg/warn1.adb | 12 ++++++++++ 21 files changed, 379 insertions(+) create mode 100644 gcc/testsuite/gnat.dg/addr1.adb create mode 100644 gcc/testsuite/gnat.dg/addr1.ads create mode 100644 gcc/testsuite/gnat.dg/array1.adb create mode 100644 gcc/testsuite/gnat.dg/array1.ads create mode 100644 gcc/testsuite/gnat.dg/array2.ads create mode 100644 gcc/testsuite/gnat.dg/conv_bug.adb create mode 100644 gcc/testsuite/gnat.dg/discr1.ads create mode 100644 gcc/testsuite/gnat.dg/discr2.adb create mode 100644 gcc/testsuite/gnat.dg/discr2.ads create mode 100644 gcc/testsuite/gnat.dg/discr3.ads create mode 100644 gcc/testsuite/gnat.dg/elab1.ads create mode 100644 gcc/testsuite/gnat.dg/elab2.adb create mode 100644 gcc/testsuite/gnat.dg/expect1.adb create mode 100644 gcc/testsuite/gnat.dg/socket1.adb create mode 100644 gcc/testsuite/gnat.dg/specs/constructor.ads create mode 100644 gcc/testsuite/gnat.dg/specs/preelab.ads create mode 100644 gcc/testsuite/gnat.dg/specs/uc1.ads create mode 100644 gcc/testsuite/gnat.dg/test_enum_io.adb create mode 100644 gcc/testsuite/gnat.dg/test_fixed_io.adb create mode 100644 gcc/testsuite/gnat.dg/test_unknown_discrs.adb create mode 100644 gcc/testsuite/gnat.dg/warn1.adb diff --git a/gcc/testsuite/gnat.dg/addr1.adb b/gcc/testsuite/gnat.dg/addr1.adb new file mode 100644 index 0000000..521d049 --- /dev/null +++ b/gcc/testsuite/gnat.dg/addr1.adb @@ -0,0 +1,17 @@ +with System; +package body addr1 is + task type T is + entry Send (Location : System.Address); + end; + task body T is + begin + accept Send (Location : System.Address) do + declare + Buffer : String (1 .. 100); + for Buffer'Address use Location; -- Test + begin + null; + end; + end Send; + end; +end; diff --git a/gcc/testsuite/gnat.dg/addr1.ads b/gcc/testsuite/gnat.dg/addr1.ads new file mode 100644 index 0000000..51061fd --- /dev/null +++ b/gcc/testsuite/gnat.dg/addr1.ads @@ -0,0 +1,5 @@ +-- { dg-do compile } + +package addr1 is + pragma Elaborate_Body; +end; diff --git a/gcc/testsuite/gnat.dg/array1.adb b/gcc/testsuite/gnat.dg/array1.adb new file mode 100644 index 0000000..0540f88 --- /dev/null +++ b/gcc/testsuite/gnat.dg/array1.adb @@ -0,0 +1,32 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } + +package body array1 is + + subtype Small is Integer range 1 .. MAX; + + type LFT is record + RIC_ID : RIC_TYPE; + end record; + + LF : array (RIC_TYPE, Small) of LFT; + + procedure Foo (R : RIC_TYPE) is + L : Small; + T : LFT renames LF (R, L); + begin + Start_Timer (T'ADDRESS); + end; + + procedure Bar (A : Integer; R : RIC_TYPE) is + S : LFT renames LF (R, A); + begin + null; + end; + + procedure Start_Timer (Q : SYSTEM.ADDRESS) is + begin + null; + end; + +end array1; diff --git a/gcc/testsuite/gnat.dg/array1.ads b/gcc/testsuite/gnat.dg/array1.ads new file mode 100644 index 0000000..8f8ecc0 --- /dev/null +++ b/gcc/testsuite/gnat.dg/array1.ads @@ -0,0 +1,9 @@ +with SYSTEM; +WITH array2; use array2; + +package array1 is + + procedure Foo (R : RIC_TYPE); + procedure Start_Timer (Q : SYSTEM.ADDRESS); + +end array1; diff --git a/gcc/testsuite/gnat.dg/array2.ads b/gcc/testsuite/gnat.dg/array2.ads new file mode 100644 index 0000000..323374f --- /dev/null +++ b/gcc/testsuite/gnat.dg/array2.ads @@ -0,0 +1,8 @@ +package array2 is + + type RIC_TYPE is (RIC1, RIC2); + for RIC_TYPE'SIZE use 32; + + function MAX return Integer; + +end array2; diff --git a/gcc/testsuite/gnat.dg/conv_bug.adb b/gcc/testsuite/gnat.dg/conv_bug.adb new file mode 100644 index 0000000..f5aaef3 --- /dev/null +++ b/gcc/testsuite/gnat.dg/conv_bug.adb @@ -0,0 +1,30 @@ +-- { dg-do run } +-- { dg-options "-gnatws" } + +with discr3; use discr3; +with Text_IO; use Text_IO; +procedure Conv_Bug is +begin + begin + V2 := S2 (V1); + exception + when Constraint_Error => null; + when others => Put_Line ("Wrong Exception raised"); + end; + + begin + V2 := S2(V1(V1'Range)); + Put_Line ("No exception raised - 2"); + exception + when Constraint_Error => null; + when others => Put_Line ("Wrong Exception raised"); + end; + + begin + V2 := S2 (V3); + Put_Line ("No exception raised - 3"); + exception + when Constraint_Error => null; + when others => Put_Line ("Wrong Exception raised"); + end; +end Conv_Bug; diff --git a/gcc/testsuite/gnat.dg/discr1.ads b/gcc/testsuite/gnat.dg/discr1.ads new file mode 100644 index 0000000..e2adab4 --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr1.ads @@ -0,0 +1,25 @@ +package discr1 is + + type R is (One, Two); + + type C_Type (Kind : R) is + record + case Kind is + when One => + Name : Integer; + when Two => + Designator : String (1 .. 40); + end case; + end record; + + for C_Type use record + Name at 0 range 0.. 31; + Designator at 0 range 0..319; + Kind at 40 range 0.. 7; + end record; + + for C_Type'Size use 44 * 8; + + procedure Assign (Id : String); + +end discr1; diff --git a/gcc/testsuite/gnat.dg/discr2.adb b/gcc/testsuite/gnat.dg/discr2.adb new file mode 100644 index 0000000..0f03a0f --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr2.adb @@ -0,0 +1,22 @@ +-- { dg-do compile } + +with discr1; use discr1; + +package body discr2 is + + procedure Copy (Dataset : in out C_Type) is + Last_Char : Positive := 300; + begin + while (Last_Char > 40) loop + Last_Char := Last_Char - 1; + end loop; + + Assign (Dataset.Designator (1 .. Last_Char)); + end; + + procedure Dummy is + begin + null; + end Dummy; + +end discr2; diff --git a/gcc/testsuite/gnat.dg/discr2.ads b/gcc/testsuite/gnat.dg/discr2.ads new file mode 100644 index 0000000..f534ba2 --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr2.ads @@ -0,0 +1,5 @@ +package discr2 is + + procedure Dummy; + +end discr2; diff --git a/gcc/testsuite/gnat.dg/discr3.ads b/gcc/testsuite/gnat.dg/discr3.ads new file mode 100644 index 0000000..37ba917 --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr3.ads @@ -0,0 +1,11 @@ +package discr3 is + type E is range 0..255; + type R1 is range 1..5; + type R2 is range 11..15; + type S1 is array(R1 range <>) of E; + type S2 is array(R2 range <>) of E; + V1 : S1( 2..3) := (0,0); + V2 : S2(12..13) := (1,1); + subtype R3 is R1 range 2..3; + V3 : S1 (R3); +end discr3; diff --git a/gcc/testsuite/gnat.dg/elab1.ads b/gcc/testsuite/gnat.dg/elab1.ads new file mode 100644 index 0000000..2d656ea --- /dev/null +++ b/gcc/testsuite/gnat.dg/elab1.ads @@ -0,0 +1,23 @@ +package elab1 is + + -- the forward declaration is the trigger + type Stream; + + type Stream_Ptr is access Stream; + + type Stream is array (Positive range <>) of Character; + + function Get_Size (S : Stream_Ptr) return Natural; + + type Rec (Size : Natural) is + record + B : Boolean; + end record; + + My_Desc : constant Stream_Ptr := new Stream'(1 => ' '); + + My_Size : constant Natural := Get_Size (My_Desc); + + subtype My_Rec is Rec (My_Size); + +end; diff --git a/gcc/testsuite/gnat.dg/elab2.adb b/gcc/testsuite/gnat.dg/elab2.adb new file mode 100644 index 0000000..3379a41 --- /dev/null +++ b/gcc/testsuite/gnat.dg/elab2.adb @@ -0,0 +1,10 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } + +with elab1; + +procedure elab2 is + A : elab1.My_Rec; +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/expect1.adb b/gcc/testsuite/gnat.dg/expect1.adb new file mode 100644 index 0000000..058fe42 --- /dev/null +++ b/gcc/testsuite/gnat.dg/expect1.adb @@ -0,0 +1,15 @@ +-- { dg-do run } + +with GNAT.Expect; use GNAT.Expect; +with Ada.Text_IO; use Ada.Text_IO; +procedure expect1 is + Process : Process_Descriptor; +begin + begin + Close (Process); + raise Program_Error; + exception + when Invalid_Process => + null; -- expected + end; +end expect1; diff --git a/gcc/testsuite/gnat.dg/socket1.adb b/gcc/testsuite/gnat.dg/socket1.adb new file mode 100644 index 0000000..f1adf7a --- /dev/null +++ b/gcc/testsuite/gnat.dg/socket1.adb @@ -0,0 +1,14 @@ +-- { dg-do run } + +with GNAT.Sockets; use GNAT.Sockets; +procedure socket1 is + X : Character; +begin + X := 'x'; + GNAT.Sockets.Initialize; + declare + H : Host_Entry_Type := Get_Host_By_Address (Inet_Addr ("127.0.0.1")); + begin + null; + end; +end socket1; diff --git a/gcc/testsuite/gnat.dg/specs/constructor.ads b/gcc/testsuite/gnat.dg/specs/constructor.ads new file mode 100644 index 0000000..aaabc41 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/constructor.ads @@ -0,0 +1,13 @@ +-- { dg-do compile } + +package constructor is + type R (Name_Length : Natural) is record + Name : Wide_String (1..Name_Length); + Multiple : Boolean; + end record; + + Null_Params : constant R := + (Name_Length => 0, + Name => "", + Multiple => False); +end; diff --git a/gcc/testsuite/gnat.dg/specs/preelab.ads b/gcc/testsuite/gnat.dg/specs/preelab.ads new file mode 100644 index 0000000..4336c75 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/preelab.ads @@ -0,0 +1,9 @@ +-- { dg-do compile } + +with Ada.Finalization; +package preelab is + type T is limited private; + pragma Preelaborable_Initialization (T); +private + type T is new Ada.Finalization.Limited_Controlled with null record; +end preelab; diff --git a/gcc/testsuite/gnat.dg/specs/uc1.ads b/gcc/testsuite/gnat.dg/specs/uc1.ads new file mode 100644 index 0000000..869103c --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/uc1.ads @@ -0,0 +1,21 @@ +-- { dg-do compile } + +with System; +with System.Storage_Elements; +with Unchecked_Conversion; + +package UC1 is + + function Conv is + new Unchecked_Conversion (Source => System.Address, Target => Integer); + function Conv is + new Unchecked_Conversion (Source => Integer, Target => System.Address); + + M : constant System.Address := System.Storage_Elements.To_Address(0); + N : constant System.Address := Conv (Conv (M) + 1); + A : constant System.Address := Conv (Conv (N) + 1); + + I : Integer; + for I use at A; + +end UC1; diff --git a/gcc/testsuite/gnat.dg/test_enum_io.adb b/gcc/testsuite/gnat.dg/test_enum_io.adb new file mode 100644 index 0000000..10771c9 --- /dev/null +++ b/gcc/testsuite/gnat.dg/test_enum_io.adb @@ -0,0 +1,33 @@ +-- { dg-do run } + +with Ada.Text_IO; +use Ada.Text_IO; + +procedure Test_Enum_IO is + + type Enum is (Literal); + package Enum_IO is new Enumeration_IO (Enum); + use Enum_IO; + + File : File_Type; + Value: Enum; + Rest : String (1 ..30); + Last : Natural; + +begin + + Create (File, Mode => Out_File); + Put_Line (File, "Literax0000000l note the 'l' at the end"); + + Reset (File, Mode => In_File); + Get (File, Value); + Get_Line (File, Rest, Last); + + Close (File); + + Put_Line (Enum'Image (Value) & Rest (1 .. Last)); + raise Program_Error; + +exception + when Data_Error => null; +end Test_Enum_IO; diff --git a/gcc/testsuite/gnat.dg/test_fixed_io.adb b/gcc/testsuite/gnat.dg/test_fixed_io.adb new file mode 100644 index 0000000..823e172 --- /dev/null +++ b/gcc/testsuite/gnat.dg/test_fixed_io.adb @@ -0,0 +1,34 @@ +-- { dg-do run } + +with Ada.Text_IO; use Ada.Text_IO; + +procedure test_fixed_io is + type FX is delta 0.0001 range -3.0 .. 250.0; + for FX'Small use 0.0001; + package FXIO is new Fixed_IO (FX); + use FXIO; + ST : String (1 .. 11) := (others => ' '); + ST2 : String (1 .. 12) := (others => ' '); + + N : constant FX := -2.345; +begin + begin + Put (ST, N, 6, 2); + Put_Line ("*ERROR* Test1: Exception Layout_Error was not raised"); + Put_Line ("ST = """ & ST & '"'); + exception + when Layout_Error => + null; + when others => + Put_Line ("Test1: Unexpected exception"); + end; + + begin + Put (ST2, N, 6, 2); + exception + when Layout_Error => + Put_Line ("*ERROR* Test2: Exception Layout_Error was raised"); + when others => + Put_Line ("Test2: Unexpected exception"); + end; +end; diff --git a/gcc/testsuite/gnat.dg/test_unknown_discrs.adb b/gcc/testsuite/gnat.dg/test_unknown_discrs.adb new file mode 100644 index 0000000..6af52df --- /dev/null +++ b/gcc/testsuite/gnat.dg/test_unknown_discrs.adb @@ -0,0 +1,31 @@ +-- { dg-do compile } + +procedure Test_Unknown_Discrs is + + package Display is + + type Component_Id (<>) is limited private; + + Deferred_Const : constant Component_Id; + + private + + type Component_Id is (Clock); + + type Rec1 is record + C : Component_Id := Deferred_Const; + end record; + + Priv_Cid_Object : Component_Id := Component_Id'First; + + type Rec2 is record + C : Component_Id := Priv_Cid_Object; + end record; + + Deferred_Const : constant Component_Id := Priv_Cid_Object; + + end Display; + +begin + null; +end Test_Unknown_Discrs; diff --git a/gcc/testsuite/gnat.dg/warn1.adb b/gcc/testsuite/gnat.dg/warn1.adb new file mode 100644 index 0000000..6dbdfa2 --- /dev/null +++ b/gcc/testsuite/gnat.dg/warn1.adb @@ -0,0 +1,12 @@ +-- { dg-do run } +-- { dg-options "-gnatwae" } + +procedure warn1 is + pragma Warnings + (Off, "variable ""Unused"" is never read and never assigned"); + Unused : Integer; + pragma Warnings + (On, "variable ""Unused"" is never read and never assigned"); +begin + null; +end warn1; -- 2.7.4