OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c2/] [c250001.aw] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C250001.AW
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 wide character literals are supported.
28
--      Check that wide character string literals are supported.
29
--
30
-- TEST DESCRIPTION:
31
--      This test utilizes the brackets scheme for representing wide character
32
--      values in transportable 7 bit ASCII as proposed by Robert Dewar;
33
--      this test defines Wide_Character and Wide_String objects, and assigns
34
--      and tests several sample values.
35
--
36
-- SPECIAL REQUIREMENTS:
37
--
38
--      This file must be preprocessed before it can be executed as a test.
39
--
40
--      This test requires that all occurrences of the bracket escape
41
--      representation for wide characters be replaced, as appropriate, with
42
--      the corresponding wide character as represented by the implementation.
43
--
44
--      Characters above ASCII.Del are represented by an 8 character sequence:
45
--
46
--          ["xxxx"]
47
--
48
--      where the character code represented is specified by four hexadecimal
49
--      digits, () upper case. For example the wide character with the
50
--      code 16#ABCD# is represented by the eight character sequence:
51
--
52
--          ["ABCD"]
53
--
54
--      The following function documents the translation algorithm:
55
--
56
--     function To_Wide( S:String ) return Wide_character is
57
--       Numerical : Natural := 0;
58
--       type Xlate is array(Character range '0'..'F') of Natural;
59
--       Xlation : Xlate
60
--               := ('0' =>  0, '1' =>  1, '2' =>  2, '3' =>  3, '4' =>  4,
61
--                   '5' =>  5, '6' =>  6, '7' =>  7, '8' =>  8, '9' =>  9,
62
--                   'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14,
63
--                   'F' => 15,  others => 0 );
64
--     begin
65
--       for I in S'Range loop
66
--         Numerical := Numerical * 16 + Xlation(S(I));
67
--       end loop;
68
--       return Wide_Character'Val(Numerical);  -- the returned value is
69
--                                   implementation dependent
70
--     exception
71
--       when Constraint_Error => raise;
72
--     end To_Wide;
73
--
74
--
75
-- CHANGE HISTORY:
76
--      26 OCT 95   SAIC   Initial .Aversion
77
--      11 APR 96   SAIC   Minor robustness changes for 2.1
78
--      12 NOV 96   SAIC   Changed file extension to .AW
79
--
80
--!
81
 
82
----------------------------------------------------------------- C250001_0
83
 
84
package C250001_0 is
85
 
86
  -- The wide characters used in this test are sequential starting with
87
  -- the character '["4F42"]' 16#0F42#
88
 
89
  Four_Eff_Four_Two : constant Wide_Character := '["4F42"]';
90
 
91
  Four_Eff_4_3_Through_9 : constant Wide_String :=
92
               "["4F43"]["4F44"]["4F45"]["4F46"]["4F47"]["4F48"]["4F49"]";
93
 
94
  Four_Eff_A_B : constant Wide_String := "["4F4A"]["4F4B"]";
95
 
96
end C250001_0;
97
 
98
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
99
 
100
-- no package body C250001_0 is required or allowed
101
 
102
------------------------------------------------------------------- C250001
103
 
104
with Report;
105
with C250001_0;
106
with Ada.Tags;
107
 
108
procedure C250001 is
109
  use C250001_0;
110
 
111
  function Hex( N: Natural ) return String is
112
    S : String := "xxxx";
113
    T : String := "0123456789ABCDEF";
114
    V : Natural := N;
115
  begin
116
    for I in reverse 1..4 loop
117
      S(I) := T(V rem 16 +1);
118
      V := V / 16;
119
    end loop;
120
    return S;
121
  end Hex;
122
 
123
  procedure Match( Check : Wide_Character; Matching : Natural ) is
124
  begin
125
    if Wide_Character'Pos( Check ) /= Matching then
126
      Report.Failed( "Didn't match for " & Hex(Matching) );
127
    end if;
128
  end Match;
129
 
130
  type Value_List is array(Positive range <>) of Natural;
131
 
132
  procedure Match( Check : Wide_String; Matching : Value_List ) is
133
  begin
134
    if Check'Length /= Matching'Length then
135
      Report.Failed( "Check'Length /= Matching'Length" );
136
    else
137
      for I in Check'Range loop
138
        Match( Check(I), Matching(I) );
139
      end loop;
140
    end if;
141
  end Match;
142
 
143
begin  -- Main test procedure.
144
 
145
  Report.Test ("C250001", "Check that wide character literals " &
146
                          "are supported.  Check that wide character " &
147
                          "string literals are supported." );
148
 
149
  Match( Four_Eff_Four_Two, 16#4F42# );
150
 
151
  Match(Four_Eff_4_3_Through_9,
152
         (16#4F43#,16#4F44#,16#4F45#,16#4F46#,16#4F47#,16#4F48#,16#4F49#) );
153
 
154
 -- check catenations
155
 
156
  Match( Four_Eff_Four_Two & Four_Eff_Four_Two, (16#4F42#,16#4F42#) );
157
 
158
  Match( Four_Eff_Four_Two & Four_Eff_A_B, (16#4F42#,16#4F4A#,16#4F4B#) );
159
 
160
  Match( Four_Eff_A_B & Four_Eff_Four_Two, (16#4F4A#,16#4F4B#,16#4F42#) );
161
 
162
  Match( Four_Eff_A_B & Four_Eff_A_B,
163
         (16#4F4A#,16#4F4B#,16#4F4A#,16#4F4B#) );
164
 
165
  Report.Result;
166
 
167
end C250001;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.