diff gcc/testsuite/ada/acats/tests/c3/c332001.a @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/c3/c332001.a	Fri Oct 27 22:46:09 2017 +0900
@@ -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;