c456001.a: New from ACATS 2.5L

2005-01-10  Laurent GUERBY <laurent@guerby.net>

	* ada/acats/tests/c4/c456001.a: New from ACATS 2.5L
	* ada/acats/tests/c3/c392014.a: Update from ACATS 2.5L
	* ada/acats/tests/c3/c92005b.ada: Likewise.
	* ada/acats/tests/c3/cxb3012.a: Likewise.
	* ada/acats/norun.lst: Add c380004 and c953002, add PR

From-SVN: r93135

6 files changed, 178 insertions, 22 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1c3629d..90b149d 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2005-01-10  Laurent GUERBY <laurent@guerby.net>
+
+	* ada/acats/tests/c4/c456001.a: New from ACATS 2.5L
+	* ada/acats/tests/c3/c392014.a: Update from ACATS 2.5L
+	* ada/acats/tests/c3/c92005b.ada: Likewise.
+	* ada/acats/tests/c3/cxb3012.a: Likewise.
+	* ada/acats/norun.lst: Add c380004 and c953002, add PR
+	
 2005-01-09  Paul Brook  <paul@codesourcery.com>
 
 	* gfortran.dg/common_2.f90: New file.
diff --git a/gcc/testsuite/ada/acats/norun.lst b/gcc/testsuite/ada/acats/norun.lst
index 6da2225..5d21693 100644
--- a/gcc/testsuite/ada/acats/norun.lst
+++ b/gcc/testsuite/ada/acats/norun.lst
@@ -1,4 +1,8 @@
+c380004
+c953002
 cdd2a03
 templat
 # Tests must be sorted in alphabetical order
-# cdd2a03: new Ada ruling not supported yet.
+# c380004: should be front-end compile time error, PR ada/18817
+# c953002: often hanging, PR ada/18820
+# cdd2a03: new Ada ruling not supported yet, PR ada/19323
diff --git a/gcc/testsuite/ada/acats/tests/c3/c392014.a b/gcc/testsuite/ada/acats/tests/c3/c392014.a
index 89d403e..8ecb414 100644
--- a/gcc/testsuite/ada/acats/tests/c3/c392014.a
+++ b/gcc/testsuite/ada/acats/tests/c3/c392014.a
@@ -31,6 +31,8 @@
 -- CHANGE HISTORY:
 --    18 JAN 2001   PHL   Initial version
 --    15 MAR 2001   RLB   Readied for release.
+--    03 JUN 2004   RLB   Removed constraint for S0, as the subtype has
+--                        unknown discriminants.
 
 --!
 package C392014_0 is
@@ -178,7 +180,7 @@ with C392014_1.Child;
 with C392014_2;
 procedure C392014 is
 
-    subtype S0 is C392014_0.T'Class (D => Ident_Int (17));
+    subtype S0 is C392014_0.T'Class;
     subtype S1 is C392014_1.T'Class;
 
     X0 : aliased C392014_0.T'Class := C392014_0.Create (Ident_Int (5218));
diff --git a/gcc/testsuite/ada/acats/tests/c4/c456001.a b/gcc/testsuite/ada/acats/tests/c4/c456001.a
new file mode 100644
index 0000000..9062f93
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/c4/c456001.a
@@ -0,0 +1,91 @@
+-- C456001.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--
+--                                     Notice
+--
+--    The ACAA has created and maintains the Ada Conformity Assessment Test
+--    Suite for the purpose of conformity assessments conducted in accordance
+--    with the International Standard ISO/IEC 18009 - Ada: Conformity
+--    assessment of a language processor. This test suite should not be used
+--    to make claims of conformance unless used in accordance with
+--    ISO/IEC 18009 and any applicable ACAA procedures.
+--
+--*
+-- OBJECTIVE:
+--     For exponentiation of floating point types, check that
+--       Constraint_Error is raised (or, if no exception is raised and
+--       Machine_Overflows is False, that a result is produced) if the
+--       result is outside of the range of the base type.
+--     This tests digits 5.
+
+-- HISTORY:
+--     04/30/03  RLB  Created test from old C45622A and C45624A.
+
+with Report;
+
+procedure C456001 is
+
+     type Flt is digits 5;
+
+     F : Flt;
+
+     function Equal_Flt (One, Two : Flt) return Boolean is
+         -- Break optimization.
+     begin
+          return One = Two * Flt (Report.Ident_Int(1));
+     end Equal_Flt;
+
+begin
+     Report.Test ("C456001", "For exponentiation of floating point types, " &
+                      "check that Constraint_Error is raised (or, if " &
+                      "if no exception is raised and Machine_Overflows is " &
+                      "False, that a result is produced) if the result is " &
+                      "outside of the range of the base type.");
+
+     begin
+         F := (Flt'Base'Last)**Report.Ident_Int (2);
+         if Flt'Machine_Overflows Then
+             Report.Failed ("Constraint_Error was not raised for " &
+                       "exponentiation");
+         else
+             -- RM95 3.5.6(7) allows disobeying RM95 4.5(10) if
+             -- Machine_Overflows is False.
+             Report.Comment ("Constraint_Error was not raised for " &
+                       "exponentiation and Machine_Overflows is False");
+         end if;
+         if not Equal_Flt (F, F) then
+             -- Optimization breaker, F must be evaluated.
+             Report.Comment ("Don't optimize F");
+         end if;
+     exception
+         when Constraint_Error =>
+             Report.Comment ("Constraint_Error was raised for " &
+                             "exponentiation");
+         when others =>
+             Report.Failed ("An exception other than Constraint_Error " &
+                            "was raised for exponentiation");
+     end;
+
+     Report.Result;
+end C456001;
diff --git a/gcc/testsuite/ada/acats/tests/c9/c92005b.ada b/gcc/testsuite/ada/acats/tests/c9/c92005b.ada
index 0c52c31..e5672a7 100644
--- a/gcc/testsuite/ada/acats/tests/c9/c92005b.ada
+++ b/gcc/testsuite/ada/acats/tests/c9/c92005b.ada
@@ -3,22 +3,22 @@
 --                             Grant of Unlimited Rights
 --
 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
---     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
 --     unlimited rights in the software and documentation contained herein.
---     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
---     this public release, the Government intends to confer upon all 
---     recipients unlimited rights  equal to those held by the Government.  
---     These rights include rights to use, duplicate, release or disclose the 
---     released technical data and computer software in whole or in part, in 
---     any manner and for any purpose whatsoever, and to have or permit others 
+--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
+--     this public release, the Government intends to confer upon all
+--     recipients unlimited rights  equal to those held by the Government.
+--     These rights include rights to use, duplicate, release or disclose the
+--     released technical data and computer software in whole or in part, in
+--     any manner and for any purpose whatsoever, and to have or permit others
 --     to do so.
 --
 --                                    DISCLAIMER
 --
 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
---     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
---     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
 --     PARTICULAR PURPOSE OF SAID MATERIAL.
 --*
@@ -26,7 +26,8 @@
 -- OBJECT VALUE IS SET DURING EXECUTION OF THE ALLOCATOR.
 
 -- WEI  3/ 4/82
--- JBG 5/25/85
+-- JBG  5/25/85
+-- RLB  1/ 7/05
 
 WITH REPORT;
  USE REPORT;
@@ -54,7 +55,7 @@ BLOCK:
                POINTER_TT1 : ATT1 := NEW TT1;
                I : BIG_INT := POINTER_TT1.ALL'STORAGE_SIZE;
           BEGIN
-               IF NOT EQUAL(INTEGER(I), INTEGER(I)) THEN
+               IF NOT EQUAL(INTEGER(I MOD 1024), INTEGER(I MOD 1024)) THEN
                     FAILED ("UNEXPECTED PROBLEM");
                END IF;
           END PACK;
diff --git a/gcc/testsuite/ada/acats/tests/cxb/cxb3012.a b/gcc/testsuite/ada/acats/tests/cxb/cxb3012.a
index 2f97e77..3771f6e 100644
--- a/gcc/testsuite/ada/acats/tests/cxb/cxb3012.a
+++ b/gcc/testsuite/ada/acats/tests/cxb/cxb3012.a
@@ -74,7 +74,10 @@
 --                          Unchecked_Conversion. Added check for raising
 --                          of Dereference_Error for Update (From Technical
 --                          Corrigendum 1).
---
+--      07 Jan 05   RLB     Modified to reflect change to Update by AI-242
+--                          (which is expected to be part of Amendment 1).
+--                          [This version allows either semantics.]
+
 --!
 
 with Report;
@@ -117,6 +120,15 @@ begin
       TC_Result_String_5 : constant String := "1a2b3";
       TC_Result_String_6 : constant String := "XXX---...";
 
+      TC_Amd_Result_String_4 :
+                           constant String := "XACVCXXXXX";
+      TC_Amd_Result_String_5 :
+                           constant String := "1a2b3XXXXX";
+      TC_Amd_Result_String_6 :
+                           constant String := "XXX---...X";
+      TC_Amd_Result_String_9 :
+                           constant String := "JustATestX";
+
       TC_char_array        : IC.char_array(0..10) := IC.To_C("XXXXXXXXXX");
       TC_Result_char_array : IC.char_array(0..10) := IC.To_C("XXXXXXXXXX");
       TC_chars_ptr         : ICS.chars_ptr;
@@ -210,16 +222,21 @@ begin
       -- but with the character values in the String overwriting the char
       -- values in Item.
       --
-      -- Note: In each of the cases below, the String parameter Str is
-      --       treated as if it were nul terminated, which means that the
-      --       char_array pointed to by TC_chars_ptr will be "shortened"
+      -- Note: In Ada 95, In each of the cases below, the String parameter
+      --       Str is treated as if it were nul terminated, which means that
+      --       the char_array pointed to by TC_chars_ptr will be "shortened"
       --       so that it ends after the last character of the Str
-      --       parameter.
+      --       parameter. For Ada 2005, this rule is dropped, so the
+      --       number of characters remains the same.
 
       TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
       ICS.Update(TC_chars_ptr, 1, TC_String_4, False);
 
-      if ICS.Value(TC_chars_ptr) /= TC_Result_String_4 then
+      if ICS.Value(TC_chars_ptr) = TC_Result_String_4 then
+         Report.Comment("Ada 95 result from Procedure Update - 5");
+      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_4 then
+         Report.Comment("Amendment 1 result from Procedure Update - 5");
+      else
          Report.Failed("Incorrect result from Procedure Update - 5");
       end if;
       ICS.Free(TC_chars_ptr);
@@ -230,7 +247,11 @@ begin
                  Offset => 0,
                  Str    => TC_String_5);
 
-      if ICS.Value(TC_chars_ptr) /= TC_Result_String_5 then
+      if ICS.Value(TC_chars_ptr) = TC_Result_String_5 then
+         Report.Comment("Ada 95 result from Procedure Update - 6");
+      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_5 then
+         Report.Comment("Amendment 1 result from Procedure Update - 6");
+      else
          Report.Failed("Incorrect result from Procedure Update - 6");
       end if;
       ICS.Free(TC_chars_ptr);
@@ -242,7 +263,11 @@ begin
                  Str    => TC_String_6,
                  Check  => True);
 
-      if ICS.Value(TC_chars_ptr) /= TC_Result_String_6 then
+      if ICS.Value(TC_chars_ptr) = TC_Result_String_6 then
+         Report.Comment("Ada 95 result from Procedure Update - 7");
+      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_6 then
+         Report.Comment("Amendment 1 result from Procedure Update - 7");
+      else
          Report.Failed("Incorrect result from Procedure Update - 7");
       end if;
       ICS.Free(TC_chars_ptr);
@@ -251,11 +276,36 @@ begin
       TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
       ICS.Update(TC_chars_ptr, 0, TC_String_9, True);
 
-      if ICS.Value(TC_chars_ptr) /= TC_String_9 then
+      if ICS.Value(TC_chars_ptr) = TC_String_9 then
+         Report.Comment("Ada 95 result from Procedure Update - 8");
+      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_9 then
+         Report.Comment("Amendment 1 result from Procedure Update - 8");
+      else
          Report.Failed("Incorrect result from Procedure Update - 8");
       end if;
       ICS.Free(TC_chars_ptr);
 
+      -- Check what happens if the string and array are the same size (this
+      -- is the case that caused the change made by the Amendment).
+      begin
+         TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+         ICS.Update(Item   => TC_chars_ptr,
+                    Offset => 0,
+                    Str    => TC_String_10,
+                    Check  => True);
+          if ICS.Value(TC_chars_ptr) = TC_String_10 then
+             Report.Comment("Amendment 1 result from Procedure Update - 9");
+          else
+             Report.Failed("Incorrect result from Procedure Update - 9");
+          end if;
+      exception
+         when ICS.Update_Error =>
+             Report.Comment("Ada 95 exception expected from Procedure Update - 9");
+         when others           =>
+           Report.Failed("Incorrect exception raised by Procedure Update " &
+                         "with Str parameter - 9");
+      end;
+      ICS.Free(TC_chars_ptr);
 
 
       -- Check that both of the above versions of Procedure Update will