OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Laurent GUERBY 2005-01-10 08:19:24 +00:00 committed by Laurent Guerby
parent 826eb7eda5
commit 8ad2a0828a
6 changed files with 178 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/testsuite/ChangeLog
View File

@ -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.

6
gcc/testsuite/ada/acats/norun.lst
View File

@ -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

4
gcc/testsuite/ada/acats/tests/c3/c392014.a
View File

@ -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));

91
gcc/testsuite/ada/acats/tests/c4/c456001.a Normal file
View File

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

23
gcc/testsuite/ada/acats/tests/c9/c92005b.ada
View File

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

68
gcc/testsuite/ada/acats/tests/cxb/cxb3012.a
View File

@ -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