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

+2008-05-22  Arnaud Charlet  <charlet@adacore.com>
+
+	* 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  <nathan@codesourcery.com>
 
 	* lib/dg-pch.exp (dg-pch): Fix if bracing.

gcc/testsuite/gnat.dg/const1.adb

+--  { dg-do compile }
+
+procedure const1 is
+   Def_Const : constant Integer;
+   pragma Import (Ada, Def_Const);
+begin
+   null;
+end const1;

gcc/testsuite/gnat.dg/notnot.adb

+--  { 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;

gcc/testsuite/gnat.dg/parameterlessfunc.adb

+--  { 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;

gcc/testsuite/gnat.dg/slice5.adb

+--  { 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;

gcc/testsuite/gnat.dg/specs/cpp_assignment.ads

+--  { 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;

gcc/testsuite/gnat.dg/specs/interface5.ads

+--  { 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;

gcc/testsuite/gnat.dg/tf_interface_1.adb

+--  { 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;

gcc/testsuite/gnat.dg/tf_interface_1.ads

+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;