From 3f9f247417d7704a6b7808ec14a4ab67d55e9f07 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 22 May 2008 09:24:10 +0000 Subject: [PATCH] slice5.adb: New test. * gnat.dg/slice5.adb: New test. * gnat.dg/notnot.adb: New test. * gnat.dg/tf_interface_1.ad[sb]: New test. * gnat.dg/const1.adb: New test. * gnat.dg/parameterlessfunc.adb: New test. * gnat.dg/specs/interface5.ads: New test. * gnat.dg/specs/cpp_assignment.ads: New test. From-SVN: r135753 --- gcc/testsuite/ChangeLog | 10 ++++++++ gcc/testsuite/gnat.dg/const1.adb | 8 +++++++ gcc/testsuite/gnat.dg/notnot.adb | 9 +++++++ gcc/testsuite/gnat.dg/parameterlessfunc.adb | 17 +++++++++++++ gcc/testsuite/gnat.dg/slice5.adb | 24 +++++++++++++++++++ .../gnat.dg/specs/cpp_assignment.ads | 10 ++++++++ gcc/testsuite/gnat.dg/specs/interface5.ads | 9 +++++++ gcc/testsuite/gnat.dg/tf_interface_1.adb | 8 +++++++ gcc/testsuite/gnat.dg/tf_interface_1.ads | 19 +++++++++++++++ 9 files changed, 114 insertions(+) create mode 100644 gcc/testsuite/gnat.dg/const1.adb create mode 100644 gcc/testsuite/gnat.dg/notnot.adb create mode 100644 gcc/testsuite/gnat.dg/parameterlessfunc.adb create mode 100644 gcc/testsuite/gnat.dg/slice5.adb create mode 100644 gcc/testsuite/gnat.dg/specs/cpp_assignment.ads create mode 100644 gcc/testsuite/gnat.dg/specs/interface5.ads create mode 100644 gcc/testsuite/gnat.dg/tf_interface_1.adb create mode 100644 gcc/testsuite/gnat.dg/tf_interface_1.ads diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a9c2b12922d..71abbb89113 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2008-05-22 Arnaud Charlet + + * gnat.dg/slice5.adb: New test. + * gnat.dg/notnot.adb: New test. + * gnat.dg/tf_interface_1.ad[sb]: New test. + * gnat.dg/const1.adb: New test. + * gnat.dg/parameterlessfunc.adb: New test. + * gnat.dg/specs/interface5.ads: New test. + * gnat.dg/specs/cpp_assignment.ads: New test. + 2008-05-22 Nathan Sidwell * lib/dg-pch.exp (dg-pch): Fix if bracing. diff --git a/gcc/testsuite/gnat.dg/const1.adb b/gcc/testsuite/gnat.dg/const1.adb new file mode 100644 index 00000000000..486e9632bc5 --- /dev/null +++ b/gcc/testsuite/gnat.dg/const1.adb @@ -0,0 +1,8 @@ +-- { dg-do compile } + +procedure const1 is + Def_Const : constant Integer; + pragma Import (Ada, Def_Const); +begin + null; +end const1; diff --git a/gcc/testsuite/gnat.dg/notnot.adb b/gcc/testsuite/gnat.dg/notnot.adb new file mode 100644 index 00000000000..3d4181aaaaa --- /dev/null +++ b/gcc/testsuite/gnat.dg/notnot.adb @@ -0,0 +1,9 @@ +-- { dg-do compile } +-- { dg-options "-gnatwr" } + +procedure notnot (x, y : integer) is +begin + if not (not (x = y)) then -- { dg-warning "redundant double negation" } + return; + end if; +end; diff --git a/gcc/testsuite/gnat.dg/parameterlessfunc.adb b/gcc/testsuite/gnat.dg/parameterlessfunc.adb new file mode 100644 index 00000000000..d63bc9addb5 --- /dev/null +++ b/gcc/testsuite/gnat.dg/parameterlessfunc.adb @@ -0,0 +1,17 @@ +-- { dg-do compile } + +procedure parameterlessfunc is + type Byte is mod 256; + type Byte_Array is array(Byte range <>) of Byte; + subtype Index is Byte range 0..7; + subtype Small_Array is Byte_Array(Index); + + function F return Byte_Array is + begin + return (0..255=>0); + end F; + + B5: Small_Array := F(Index); +begin + null; +end parameterlessfunc; diff --git a/gcc/testsuite/gnat.dg/slice5.adb b/gcc/testsuite/gnat.dg/slice5.adb new file mode 100644 index 00000000000..c619b2f60ab --- /dev/null +++ b/gcc/testsuite/gnat.dg/slice5.adb @@ -0,0 +1,24 @@ +-- { dg-do compile } +-- { dg-options "-gnatwr" } + +procedure Slice5 is + + type Item_Type is record + I : Integer; + end record; + + type Index_Type is (A, B); + + type table is array (integer range <>) of integer; + subtype Small is Integer range 1 .. 10; + T1 : constant Table (Small) := (Small => 0); + T2 : constant Table (Small) := T1 (Small); -- { dg-warning "redundant slice denotes whole array" } + + Item_Array : constant array (Index_Type) of Item_Type + := (A => (I => 10), B => (I => 22)); + + Item : Item_Type; + for Item'Address use Item_Array(Index_Type)'Address; -- { dg-warning "redundant slice denotes whole array" } +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/specs/cpp_assignment.ads b/gcc/testsuite/gnat.dg/specs/cpp_assignment.ads new file mode 100644 index 00000000000..3247b671bd5 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/cpp_assignment.ads @@ -0,0 +1,10 @@ +-- { dg-do compile } + +package CPP_Assignment is + type T is tagged record + Data : Integer := 0; + end record; + pragma Convention (CPP, T); + + Obj1 : T := (Data => 1); Obj2 : T'Class := Obj1; +end; diff --git a/gcc/testsuite/gnat.dg/specs/interface5.ads b/gcc/testsuite/gnat.dg/specs/interface5.ads new file mode 100644 index 00000000000..842b5e3fe60 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/interface5.ads @@ -0,0 +1,9 @@ +-- { dg-do compile } +-- { dg-options "-gnatc" } + +package interface5 is + type Lim_Iface is limited interface; + protected type Prot_Typ is new Lim_Iface with + private + end Prot_Typ; +end interface5; diff --git a/gcc/testsuite/gnat.dg/tf_interface_1.adb b/gcc/testsuite/gnat.dg/tf_interface_1.adb new file mode 100644 index 00000000000..352e7e4a832 --- /dev/null +++ b/gcc/testsuite/gnat.dg/tf_interface_1.adb @@ -0,0 +1,8 @@ +-- { dg-do compile } +package body TF_Interface_1 is + procedure Get_It (Handle : Stream_Access; It : out CF_Interface_1'class) + is + begin + CF_Interface_1'Class'Read (Handle, It); + end; +end; diff --git a/gcc/testsuite/gnat.dg/tf_interface_1.ads b/gcc/testsuite/gnat.dg/tf_interface_1.ads new file mode 100644 index 00000000000..15c5a64cb85 --- /dev/null +++ b/gcc/testsuite/gnat.dg/tf_interface_1.ads @@ -0,0 +1,19 @@ +with Ada.Streams; +with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; +package TF_INTERFACE_1 is + + type CF_INTERFACE_1 is interface; + + procedure P_PROCEDURE_1 (This : in out CF_INTERFACE_1) + is abstract; + + procedure Read (Stream : not null access ada.Streams.Root_stream_Type'Class; + Item : out CF_INTERFACE_1) is null; + for CF_INTERFACE_1'Read use Read; + + procedure Write (Stream : not null access ada.Streams.Root_stream_Type'Class; + Item : CF_INTERFACE_1) is null; + for CF_INTERFACE_1'Write use Write; + + procedure Get_It (Handle : Stream_Access; It : out CF_Interface_1'class); +end TF_INTERFACE_1; -- 2.30.2