+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.
+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
-- 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
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));
--- /dev/null
+-- 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;
-- 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.
--*
-- 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;
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;
-- 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;
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;
-- 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);
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);
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);
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
projects / thirdparty / gcc.git / commitdiff
