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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a9c2b12922daa4002c8f760e18a46ac80a82a903..71abbb891131684580b36c10a038ad12551c3103 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+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.

diff --git a/gcc/testsuite/gnat.dg/const1.adb b/gcc/testsuite/gnat.dg/const1.adb
new file mode 100644 (file)
index 0000000..486e963
--- /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 (file)
index 0000000..3d4181a
--- /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 (file)
index 0000000..d63bc9a
--- /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 (file)
index 0000000..c619b2f
--- /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 (file)
index 0000000..3247b67
--- /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 (file)
index 0000000..842b5e3
--- /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 (file)
index 0000000..352e7e4
--- /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 (file)
index 0000000..15c5a64
--- /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;