gcc/testsuite/ada/acats/tests/c3/c352001.a

   1 --
   2 -- C352001.A
   3 --
   4 --                             Grant of Unlimited Rights
   5 --
   6 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   7 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   8 --     unlimited rights in the software and documentation contained herein.
   9 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
  10 --     this public release, the Government intends to confer upon all
  11 --     recipients unlimited rights  equal to those held by the Government.
  12 --     These rights include rights to use, duplicate, release or disclose the
  13 --     released technical data and computer software in whole or in part, in
  14 --     any manner and for any purpose whatsoever, and to have or permit others
  15 --     to do so.
  16 --
  17 --                                    DISCLAIMER
  18 --
  19 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  20 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  21 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  22 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  23 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  24 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  25 --*
  26 --
  27 -- OBJECTIVE:
  28 --      Check that the predefined Character type comprises 256 positions.
  29 --      Check that the names of the non-graphic characters are usable with
  30 --      the attributes (Wide_)Image and (Wide_)Value, and that these
  31 --      attributes produce the correct result.
  32 --
  33 -- TEST DESCRIPTION:
  34 --      Build two tables of nongraphic characters from positions of Row 00
  35 --      (0000-001F and 007F-009F) of the ISO 10646 Basic Multilingual Plane.
  36 --      Fill the first table with compiler created strings. Fill the second
  37 --      table with strings defined by the language.  Compare the two tables.
  38 --      Check 256 positions of the predefined character type.  Use attributes
  39 --      (Wide_)Image and (Wide_)Value to check the values of the non-graphic
  40 --      characters and the last 2 characters.
  41 --
  42 --
  43 -- CHANGE HISTORY:
  44 --      20 Jun 95   SAIC    Initial prerelease version.
  45 --      27 Jan 96   SAIC    Revised for 2.1.  Hid values, added "del" case.
  46 --
  47 --!
  48
  49 with Ada.Characters.Handling;
  50 with Report;
  51 procedure C352001 is
  52
  53    Lower_Bound  : Integer  :=  0;
  54    Middle_Bound : Integer  := 31;
  55    Upper_Bound  : Integer  := 159;
  56    Half_Bound   : Integer  := 127;
  57    Max_Bound    : Integer  := 255;
  58
  59    type Dyn_String is access String;
  60    type Value_Result is array (Character) of Dyn_String;
  61
  62    Table_Of_Character : Value_Result;
  63    TC_Table           : Value_Result;
  64
  65    function CVII(K : Natural) return Character is
  66    begin
  67      return Character'Val( Report.Ident_Int(K) );
  68    end CVII;
  69
  70    function "=" (L, R : String) return Boolean is
  71       UCL : String (L'First .. L'Last);
  72       UCR : String (R'First .. R'last);
  73    begin
  74       UCL := Ada.Characters.Handling.To_Upper (L);
  75       UCR := Ada.Characters.Handling.To_Upper (R);
  76       if UCL'Last /= UCR'Last then
  77          return False;
  78       else
  79          for I in UCL'First .. UCR'Last loop
  80             if UCL (I) /= UCR (I) then
  81                return False;
  82             end if;
  83          end loop;
  84          return True;
  85        end if;
  86    end "=";
  87
  88 begin
  89
  90    Report.Test ("C352001", "Check that, the predefined Character type "     &
  91                 "comprises 256 positions.  Check that the names of the "    &
  92                 "non-graphic characters are usable with the attributes "    &
  93                 "(Wide_)Image and (Wide_)Value, and that these attributes " &
  94                 "produce the correct result");
  95
  96    -- Fill table with strings (positions of Row 00 (0000-001F) of the ISO
  97    -- 10646 Basic Multilingual Plane created by the compiler.
  98
  99    for I in CVII(Lower_Bound) .. CVII(Middle_Bound) loop
 100       Table_Of_Character (I) := new String'(Character'Image(I));
 101    end loop;
 102
 103    -- Fill table with strings (positions of Row 00 (007F-009F) of the ISO
 104    -- 10646 Basic Multilingual Plane created by the compiler.
 105
 106    for I in CVII(Half_Bound) .. CVII(Upper_Bound) loop
 107       Table_Of_Character (I) := new String'(Character'Image(I));
 108    end loop;
 109
 110    -- Fill table with strings (positions of Row 00 (0000-001F) of the ISO
 111    -- 10646 Basic Multilingual Plane defined by the language.
 112
 113    TC_Table (CVII(0))   := new String'("nul");
 114    TC_Table (CVII(1))   := new String'("soh");
 115    TC_Table (CVII(2))   := new String'("stx");
 116    TC_Table (CVII(3))   := new String'("etx");
 117    TC_Table (CVII(4))   := new String'("eot");
 118    TC_Table (CVII(5))   := new String'("enq");
 119    TC_Table (CVII(6))   := new String'("ack");
 120    TC_Table (CVII(7))   := new String'("bel");
 121    TC_Table (CVII(8))   := new String'("bs");
 122    TC_Table (CVII(9))   := new String'("ht");
 123    TC_Table (CVII(10))  := new String'("lf");
 124    TC_Table (CVII(11))  := new String'("vt");
 125    TC_Table (CVII(12))  := new String'("ff");
 126    TC_Table (CVII(13))  := new String'("cr");
 127    TC_Table (CVII(14))  := new String'("so");
 128    TC_Table (CVII(15))  := new String'("si");
 129    TC_Table (CVII(16))  := new String'("dle");
 130    TC_Table (CVII(17))  := new String'("dc1");
 131    TC_Table (CVII(18))  := new String'("dc2");
 132    TC_Table (CVII(19))  := new String'("dc3");
 133    TC_Table (CVII(20))  := new String'("dc4");
 134    TC_Table (CVII(21))  := new String'("nak");
 135    TC_Table (CVII(22))  := new String'("syn");
 136    TC_Table (CVII(23))  := new String'("etb");
 137    TC_Table (CVII(24))  := new String'("can");
 138    TC_Table (CVII(25))  := new String'("em");
 139    TC_Table (CVII(26))  := new String'("sub");
 140    TC_Table (CVII(27))  := new String'("esc");
 141    TC_Table (CVII(28))  := new String'("fs");
 142    TC_Table (CVII(29))  := new String'("gs");
 143    TC_Table (CVII(30))  := new String'("rs");
 144    TC_Table (CVII(31))  := new String'("us");
 145    TC_Table (CVII(127)) := new String'("del");
 146
 147    -- Fill table with strings (positions of Row 00 (007F-009F) of the ISO
 148    -- 10646 Basic Multilingual Plane defined by the language.
 149
 150    TC_Table (CVII(128)) := new String'("reserved_128");
 151    TC_Table (CVII(129)) := new String'("reserved_129");
 152    TC_Table (CVII(130)) := new String'("bph");
 153    TC_Table (CVII(131)) := new String'("nbh");
 154    TC_Table (CVII(132)) := new String'("reserved_132");
 155    TC_Table (CVII(133)) := new String'("nel");
 156    TC_Table (CVII(134)) := new String'("ssa");
 157    TC_Table (CVII(135)) := new String'("esa");
 158    TC_Table (CVII(136)) := new String'("hts");
 159    TC_Table (CVII(137)) := new String'("htj");
 160    TC_Table (CVII(138)) := new String'("vts");
 161    TC_Table (CVII(139)) := new String'("pld");
 162    TC_Table (CVII(140)) := new String'("plu");
 163    TC_Table (CVII(141)) := new String'("ri");
 164    TC_Table (CVII(142)) := new String'("ss2");
 165    TC_Table (CVII(143)) := new String'("ss3");
 166    TC_Table (CVII(144)) := new String'("dcs");
 167    TC_Table (CVII(145)) := new String'("pu1");
 168    TC_Table (CVII(146)) := new String'("pu2");
 169    TC_Table (CVII(147)) := new String'("sts");
 170    TC_Table (CVII(148)) := new String'("cch");
 171    TC_Table (CVII(149)) := new String'("mw");
 172    TC_Table (CVII(150)) := new String'("spa");
 173    TC_Table (CVII(151)) := new String'("epa");
 174    TC_Table (CVII(152)) := new String'("sos");
 175    TC_Table (CVII(153)) := new String'("reserved_153");
 176    TC_Table (CVII(154)) := new String'("sci");
 177    TC_Table (CVII(155)) := new String'("csi");
 178    TC_Table (CVII(156)) := new String'("st");
 179    TC_Table (CVII(157)) := new String'("osc");
 180    TC_Table (CVII(158)) := new String'("pm");
 181    TC_Table (CVII(159)) := new String'("apc");
 182
 183
 184    -- Compare the first half of two tables.
 185    for I in CVII(Lower_Bound) .. CVII(Middle_Bound) loop
 186      if TC_Table(I).all /= Table_Of_Character(I).all then
 187        Report.Failed("Value of character#" & Integer'Image(Character'Pos(I)) &
 188                      " is not the same in the first half of the table");
 189      end if;
 190    end loop;
 191
 192
 193    -- Compare the second half of two tables.
 194    for I in CVII(Half_Bound) .. CVII(Upper_Bound) loop
 195      if TC_Table(I).all /= Table_Of_Character(I).all then
 196        Report.Failed("Value of character#" & Integer'Image(Character'Pos(I)) &
 197                      " is not the same in the second half of the table");
 198      end if;
 199    end loop;
 200
 201
 202    -- Check the first character.
 203    if Character'Image( Character'First ) /= "NUL" then
 204       Report.Failed("Value of character#"                           &
 205                      Integer'Image(Character'Pos (Character'First)) &
 206                     " is not NUL");
 207    end if;
 208
 209
 210    -- Check that the names of the non-graphic characters are usable with
 211    -- Image and Value attributes.
 212    if Character'Value( Character'Image( CVII(153) )) /=
 213      CVII( 153 ) then
 214         Report.Failed ("Value of character#"                       &
 215                         Integer'Image( Character'Pos(CVII(153)) )  &
 216                        " is not reserved_153");
 217    end if;
 218
 219
 220    for I in CVII(Lower_Bound) .. CVII(Max_Bound) loop
 221      if Character'Value(
 222           Report.Ident_Str(
 223             Character'Image(CVII(Character'Pos(I)))))
 224         /= CVII( Character'Pos(I)) then
 225           Report.Failed ("Value of character#"                             &
 226                           Integer'Image( Character'Pos(I) )                &
 227                          " is not the same as the predefined character type");
 228      end if;
 229    end loop;
 230
 231
 232    -- Check Wide_Character attributes.
 233    for I in Wide_Character'Val(Lower_Bound) .. Wide_Character'Val(Max_Bound)
 234    loop
 235      if Wide_Character'Wide_Value(
 236           Report.Ident_Wide_Str(
 237             Wide_Character'Wide_Image(
 238               Wide_Character'Val(Wide_Character'Pos(I)))))
 239         /= Wide_Character'Val(Wide_Character'Pos(I))
 240      then
 241         Report.Failed ("Value of the predefined Wide_Character type " &
 242                        "is not correct");
 243      end if;
 244    end loop;
 245
 246
 247    if Wide_Character'Value( Wide_Character'Image(Wide_Character'Val(132)) )
 248      /= Wide_Character'Val( Report.Ident_Int(132) ) then
 249         Report.Failed ("Wide_Character at 132 is not reserved_132");
 250    end if;
 251
 252
 253    if Wide_Character'Image( Wide_Character'First ) /= "NUL" then
 254       Report.Failed ("Wide_Character'First is not NUL");
 255    end if;
 256
 257
 258    if Wide_Character'Image
 259      (Wide_Character'Pred (Wide_Character'Last) ) /= "FFFE" then
 260       Report.Failed ("Wide_Character at 65534 is not FFFE");
 261    end if;
 262
 263
 264    if Wide_Character'Image(Wide_Character'Last) /= "FFFF" then
 265       Report.Failed ("Wide_Character'Last is not FFFF");
 266    end if;
 267
 268    Report.Result;
 269
 270 end C352001;