diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c332001.a')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c332001.a | 226 |
1 files changed, 226 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c332001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c332001.a new file mode 100644 index 000000000..21d657373 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c332001.a @@ -0,0 +1,226 @@ +-- C332001.A +-- +-- 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 +-- 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 +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- 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 +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- +-- OBJECTIVE: +-- Check that the static expression given for a number declaration may be +-- of any numeric type. Check that the type of a named number is +-- universal_integer or universal_real regardless of the type of the +-- static expression that provides its value. +-- +-- TEST DESCRIPTION: +-- This test defines a large cross section of mixed type named numbers. +-- Well, obviously the named numbers don't have types (other than +-- universal_integer and universal_real) associated with them. +-- This test uses typed static values in the definition of several named +-- numbers, and then mixes the named numbers to ensure that their typed +-- origins do not interfere with the use of their values. +-- +-- +-- CHANGE HISTORY: +-- 10 OCT 95 SAIC Initial version +-- 11 APR 96 SAIC Fixed a few arithmetic errors for 2.1 +-- 24 NOV 98 RLB Removed decimal types to insure that this +-- test is applicable to all implementations. +-- +--! + +----------------------------------------------------------------- C332001_0 + +package C332001_0 is + + type Enumeration_Type is ( Ah, Gnome, Er, Ay, Shun ); + + type Integer_Type is range 0..1023; + + type Modular_Type is mod 256; + + type Floating_Type is digits 4; + + type Fixed_Type is delta 0.125 range -10.0 .. 10.0; + + type Mod_Array is array(Modular_Type) of Floating_Type; + + type Int_Array is array(Integer_Type) of Fixed_Type; + + type Record_Type is record + Pinkie : Integer_Type; + Ring : Modular_Type; + Middle : Floating_Type; + Index : Fixed_Type; + end record; + + Mod_Array_Object : Mod_Array; + Int_Array_Object : Int_Array; + + Record_Object : Record_Type; + + -- numeric_literals + + Nothing_New_Integer : constant := 1; + Nothing_New_Real : constant := 1.0; + + -- static constants + + Integ : constant Integer_Type := 2; + Modul : constant Modular_Type := 2; + Float : constant Floating_Type := 2.0; -- bad practice, good test + Fixed : constant Fixed_Type := 2.0; + + Named_Integer : constant := Integ; -- 2 + Named_Modular : constant := Modul; -- 2 + Named_Float : constant := Float; -- 2.0 + Named_Fixed : constant := Fixed; -- 2.0 + + -- function calls + -- parenthetical expressions + + Fn_Integer : constant := Integer_Type'Min(Integ * 2, 8); -- 4 + Fn_Modular : constant := Modular_Type'Max(Modul + 2, Modular_Type'First);--4 + Fn_Float : constant := (Float ** 2); -- 4.0 + Fn_Fixed : constant := - Fixed; -- -2.0 + -- attributes + + ITF : constant := Integer_Type'First; -- 0 + MTL : constant := Modular_Type'Last; -- 255 + MTM : constant := Modular_Type'Modulus; -- 256 + ENP : constant := Enumeration_Type'Pos(Ay); -- 3 + MTP : constant := Modular_Type'Pred(Modul); -- 1 + FTS : constant := Fixed_Type'Size; -- # impdef + ITS : constant := Integer_Type'Succ(Integ); -- 3 + + -- array attributes 'First, 'Last, 'Length + + MAFirst : constant := Mod_Array_Object'First; -- 0 + IALast : constant := Int_Array_Object'Last; -- 1023 + MAL : constant := Mod_Array_Object'Length; -- 255 + IAL : constant := Int_Array_Object'Length; -- 1024 + + -- type conversions + -- + -- F\T Int Mod Flt Fix + -- Int . X O X + -- Mod O . X O + -- Flt X O . X + -- Fix O X O . + + Int2Mod : constant := Modular_Type (Integ); -- 2 + Int2Fix : constant := Fixed_Type (Integ); -- 2.0 + Mod2Flt : constant := Floating_Type (Modul); -- 2.0 + Flt2Int : constant := Integer_Type(Float); -- 2 + Flt2Fix : constant := Fixed_Type (Float); -- 2.0 + Fix2Mod : constant := Modular_Type (Fixed); -- 2 + + procedure Check_Values; + + -- TRANSITION CHECKS + -- + -- The following were illegal in Ada83; they are now legal in Ada95 + -- + + Int_Base_First : constant := Integer'Base'First; -- # impdef + Int_First : constant := Integer'First; -- # impdef + Int_Last : constant := Integer'Last; -- # impdef + Int_Val : constant := Integer'Val(17); -- 17 + + -- END OF TRANSITION CHECKS + +end C332001_0; + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +with Report; +package body C332001_0 is + + procedure Assert( Truth : Boolean; Message: String ) is + begin + if not Truth then + Report.Failed("Assertion " & Message & " not true" ); + end if; + end Assert; + + procedure Check_Values is + begin + + Assert( Nothing_New_Integer * Named_Integer = Named_Modular, + "Nothing_New_Integer * Named_Integer = Named_Modular" ); -- 1*2 = 2 + Assert( Nothing_New_Real * Named_Float = Named_Fixed, + "Nothing_New_Real * Named_Float = Named_Fixed" );-- 1.0*2.0 = 2.0 + + Assert( Fn_Integer = Int2Mod + Flt2Int, + "Fn_Integer = Int2Mod + Flt2Int" ); -- 4 = 2+2 + Assert( Fn_Modular = Flt2Int * 2, + "Fn_Modular = Flt2Int * 2" ); -- 4 = 2*2 + Assert( Fn_Float = Mod2Flt ** Fix2Mod, + "Fn_Float = Mod2Flt ** Fix2Mod" ); -- 4.0 = 2.0**2 + Assert( Fn_Fixed = (- Mod2Flt), + "Fn_Fixed = (- Mod2Flt)" ); -- -2.0 = (-2.0) + + Assert( ITF = Modular_Type'First, + "ITF = Modular_Type'First" ); -- 0 = 0 + Assert( MTL < Integer_Type'Last, + "MTL < Integer_Type'Last" ); -- 255 < 1023 + Assert( MTM < Integer_Type'Last, + "MTM < Integer_Type'Last" ); -- 256 < 1023 + Assert( ENP > MTP, + "ENP > MTP" ); -- 3 > 1 + Assert( (FTS < MTL) or (FTS >= MTL), -- given FTS is impdef... + "(FTS < MTL) or (FTS >= MTL)" ); -- True + Assert( FTS > ITS, + "FTS > ITS" ); -- impdef > 3 + + Assert( MAFirst = Int_Array_Object'First, + "MAFirst = Int_Array_Object'First" ); -- 0 = 0 + Assert( IALast > MAFirst, + "IALast > MAFirst" ); -- 1023 > 0 + Assert( MAL < IAL, + "MAL < IAL" ); -- 255 < 1024 + + Assert( Mod2Flt = Flt2Fix, + "Mod2Flt = Flt2Fix" ); -- 2.0 = 2.0 + + end Check_Values; + +end C332001_0; + +------------------------------------------------------------------- C332001 + +with Report; +with C332001_0; +procedure C332001 is + +begin -- Main test procedure. + + Report.Test ("C332001", "Check that the static expression given for a " & + "number declaration may be of any numeric type. " & + "Check that the type of the named number is " & + "universal_integer of universal_real regardless " & + "of the type of the static expression that " & + "provides its value" ); + + C332001_0.Check_Values; + + Report.Result; + +end C332001; |