gcc/testsuite/ada/acats/tests/cd/cd92001.a

   1 -- CD92001.A
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 --
  26 -- OBJECTIVE:
  27 --      Check that if X denotes a scalar object, X'Valid
  28 --      yields true if an only if the object denoted by X is normal and
  29 --      has a valid representation.
  30 --
  31 -- TEST DESCRIPTION:
  32 --      Using Unchecked_Conversion, Image and Value attributes, combined
  33 --      with string manipulation, cause valid and invalid values to be
  34 --      stored in various objects.  Check their validity with the
  35 --      attribute 'Valid.  Invalid objects are created in a loop which
  36 --      performs a simplistic check to ensure that the values being used
  37 --      are indeed not valid, then assigns the value using an instance of
  38 --      Unchecked_Conversion.  The creation of the tables of valid values
  39 --      is trivial.
  40 --
  41 -- APPLICABILITY CRITERIA:
  42 --      All implementations must attempt to compile this test.
  43 --
  44 --      For implementations validating against Systems Programming Annex (C):
  45 --        this test must execute and report PASSED.
  46 --
  47 --      For implementations not validating against Annex C:
  48 --        this test may report compile time errors at one or more points
  49 --        indicated by "-- N/A => ERROR", in which case it may be graded as
  50 --        inapplicable. Otherwise, the test must execute and report PASSED.
  51 --
  52 --
  53 -- CHANGE HISTORY:
  54 --      10 MAY 95   SAIC    Initial version
  55 --      07 MAY 96   SAIC    Changed U_C to Ada.U_C for 2.1
  56 --      05 JAN 99   RLB     Added Component_Size clauses to compensate
  57 --                          for the fact that there is no required size
  58 --                          for either the enumeration or modular components.
  59 --!
  60
  61 with Report;
  62 with Ada.Unchecked_Conversion;
  63 with System;
  64 procedure CD92001 is
  65
  66   type Sparse_Enumerated is
  67        ( Help, Home, Page_Up, Del, EndK,
  68          Page_Down, Up, Left, Down, Right );
  69
  70   for Sparse_Enumerated use ( Help      =>    2,
  71                               Home      =>    4,
  72                               Page_Up   =>    8,
  73                               Del       =>   16,
  74                               EndK      =>   32,
  75                               Page_Down =>   64,
  76                               Up        =>  128,
  77                               Left      =>  256,
  78                               Down      =>  512,
  79                               Right     => 1024 );
  80
  81   type Mod_10 is mod 10;
  82
  83   type Default_Enumerated is ( Zero,  One, Two,   Three, Four,
  84                                Five,  Six, Seven, Eight, Nine,
  85                                Clear, '=', '/',   '*',   '-',
  86                                '+',   Enter );
  87     for Default_Enumerated'Size use 8;
  88
  89   Default_Enumerated_Count : constant := 17;
  90
  91   type Mod_By_Enum_Items is mod Default_Enumerated_Count;
  92
  93   type Mod_Same_Size_As_Sparse_Enum is mod 2**12;
  94                                         -- Sparse_Enumerated 'Size;
  95
  96   type Mod_Same_Size_As_Def_Enum is mod 2**8;
  97                                      -- Default_Enumerated'Size;
  98
  99   subtype Test_Width is Positive range 1..100;
 100
 101   -- Note: There is no required relationship between 'Size and 'Component_Size,
 102   -- so we must use component_size clauses here.
 103   -- We use the following expressions to insure that the component size is a
 104   -- multiple of the Storage_Unit.
 105   Sparse_Component_Size : constant := ((Sparse_Enumerated'Size / System.Storage_Unit) +
 106         Boolean'Pos((Sparse_Enumerated'Size mod System.Storage_Unit) /= 0)) *
 107         System.Storage_Unit;
 108   Default_Component_Size : constant := ((Default_Enumerated'Size / System.Storage_Unit) +
 109         Boolean'Pos((Sparse_Enumerated'Size mod System.Storage_Unit) /= 0)) *
 110         System.Storage_Unit;
 111
 112   type Sparse_Enum_Table is array(Test_Width) of Sparse_Enumerated;
 113   for Sparse_Enum_Table'Component_Size use Sparse_Component_Size;  -- N/A => ERROR.
 114   type Def_Enum_Table is array(Test_Width) of Default_Enumerated;
 115   for Def_Enum_Table'Component_Size use Default_Component_Size;  -- N/A => ERROR.
 116
 117   type Sparse_Mod_Table  is
 118        array(Test_Width) of Mod_Same_Size_As_Sparse_Enum;
 119   for Sparse_Mod_Table'Component_Size use Sparse_Component_Size;  -- N/A => ERROR.
 120
 121   type Default_Mod_Table is
 122        array(Test_Width) of Mod_Same_Size_As_Def_Enum;
 123   for Default_Mod_Table'Component_Size use Default_Component_Size;  -- N/A => ERROR.
 124
 125   function UC_Sparse_Mod_Enum is
 126     new Ada.Unchecked_Conversion( Sparse_Mod_Table, Sparse_Enum_Table );
 127
 128   function UC_Def_Mod_Enum is
 129     new Ada.Unchecked_Conversion( Default_Mod_Table, Def_Enum_Table );
 130
 131   Valid_Sparse_Values : Sparse_Enum_Table;
 132   Valid_Def_Values    : Def_Enum_Table;
 133
 134   Sample_Enum_Value_Table : Sparse_Mod_Table;
 135   Sample_Def_Value_Table  : Default_Mod_Table;
 136
 137
 138   -- fill the Valid tables with valid values for conversion
 139   procedure Fill_Valid is
 140     K : Mod_10 := 0;
 141     P : Mod_By_Enum_Items := 0;
 142   begin
 143     for I in Test_Width loop
 144       Valid_Sparse_Values(I) := Sparse_Enumerated'Val( K );
 145       Valid_Def_Values(I)    := Default_Enumerated'Val( Integer(P) );
 146       K := K +1;
 147       P := P +1;
 148     end loop;
 149   end Fill_Valid;
 150
 151   -- fill the Sample tables with invalid values for conversion
 152   procedure Fill_Invalid is
 153     K : Mod_Same_Size_As_Sparse_Enum := 1;
 154     P : Mod_Same_Size_As_Def_Enum    := 1;
 155   begin
 156     for I in Test_Width loop
 157       K := K +13;
 158       if K mod 2 = 0 then  -- oops, that would be a valid value
 159         K := K +1;
 160       end if;
 161       if P = Mod_Same_Size_As_Def_Enum'Last
 162          or P < Default_Enumerated_Count then -- that would be valid
 163         P := Default_Enumerated_Count + 1;
 164       else
 165         P := P +1;
 166       end if;
 167       Sample_Enum_Value_Table(I) := K;
 168       Sample_Def_Value_Table(I)  := P;
 169     end loop;
 170
 171     Valid_Sparse_Values := UC_Sparse_Mod_Enum(Sample_Enum_Value_Table);
 172     Valid_Def_Values    := UC_Def_Mod_Enum(Sample_Def_Value_Table);
 173
 174   end Fill_Invalid;
 175
 176   -- fill the tables with second set of valid values for conversion
 177   procedure Refill_Valid is
 178     K : Mod_10 := 0;
 179     P : Mod_By_Enum_Items := 0;
 180
 181     Table : Array(Mod_10) of Mod_Same_Size_As_Sparse_Enum
 182           := ( 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024 );
 183
 184   begin
 185     for I in Test_Width loop
 186       Sample_Enum_Value_Table(I) := Table(K);
 187       Sample_Def_Value_Table(I)  := Mod_Same_Size_As_Def_Enum(P);
 188       K := K +1;
 189       P := P +1;
 190     end loop;
 191     Valid_Sparse_Values := UC_Sparse_Mod_Enum(Sample_Enum_Value_Table);
 192     Valid_Def_Values    := UC_Def_Mod_Enum(Sample_Def_Value_Table);
 193   end Refill_Valid;
 194
 195   procedure Validate(Expect_Valid: Boolean) is
 196   begin  -- here's where we actually use the tested attribute
 197
 198     for K in Test_Width loop
 199       if Valid_Sparse_Values(K)'Valid /= Expect_Valid then
 200         Report.Failed("Expected 'Valid =" & Boolean'Image(Expect_Valid)
 201                     & " for Sparse item " & Integer'Image(K) );
 202       end if;
 203     end loop;
 204
 205     for P in Test_Width loop
 206       if Valid_Def_Values(P)'Valid /= Expect_Valid then
 207         Report.Failed("Expected 'Valid =" & Boolean'Image(Expect_Valid)
 208                     & " for Default item " & Integer'Image(P) );
 209       end if;
 210     end loop;
 211
 212   end Validate;
 213
 214 begin  -- Main test procedure.
 215
 216   Report.Test ("CD92001", "Check object attribute: X'Valid" );
 217
 218   Fill_Valid;
 219   Validate(True);
 220
 221   Fill_Invalid;
 222   Validate(False);
 223
 224   Refill_Valid;
 225   Validate(True);
 226
 227   Report.Result;
 228
 229 end CD92001;