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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxb/] [cxb4001.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CXB4001.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 the specifications of the package Interfaces.COBOL
28
--      are available for use
29
--
30
-- TEST DESCRIPTION:
31
--      This test verifies that the type and the subprograms specified for
32
--      the interface are present.
33
--
34
-- APPLICABILITY CRITERIA:
35
--      This test is applicable to all implementations that provide
36
--      package Interfaces.COBOL.  If an implementation provides
37
--      package Interfaces.COBOL, this test must compile, execute, and
38
--      report "PASSED".
39
--
40
--
41
-- CHANGE HISTORY:
42
--      06 Dec 94   SAIC    ACVC 2.0
43
--      15 Nov 95   SAIC    Corrected visibility errors for ACVC 2.0.1.
44
--      28 Feb 96   SAIC    Added applicability criteria.
45
--      27 Oct 96   SAIC    Incorporated reviewer comments.
46
--      01 DEC 97   EDS     Change "To_Comp" to "To_Binary".
47
--!
48
 
49
with Report;
50
with Interfaces.COBOL;                                        -- N/A => ERROR
51
 
52
procedure CXB4001 is
53
 
54
   package COBOL renames Interfaces.COBOL;
55
   use type COBOL.Byte;
56
   use type COBOL.Decimal_Element;
57
 
58
begin
59
 
60
   Report.Test ("CXB4001", "Check the specification of Interfaces.COBOL");
61
 
62
 
63
   declare  -- encapsulate the test
64
 
65
      --  Types and operations for internal data representations
66
 
67
      TST_Floating : COBOL.Floating;
68
      TST_Long_Floating : COBOL.Long_Floating;
69
 
70
      TST_Binary        : COBOL.Binary;
71
      TST_Long_Binary   : COBOL.Long_Binary;
72
 
73
      TST_Max_Digits_Binary      : constant := COBOL.Max_Digits_Binary;
74
      TST_Max_Digits_Long_Binary : constant := COBOL.Max_Digits_Long_Binary;
75
 
76
      TST_Decimal_Element : COBOL.Decimal_Element;
77
 
78
      TST_Packed_Decimal : COBOL.Packed_Decimal (1..5) :=
79
                                    (others => COBOL.Decimal_Element'First);
80
 
81
      --  initialize it so it can reasonably be used later
82
      TST_COBOL_Character : COBOL.COBOL_Character :=
83
                                                COBOL.COBOL_Character'First;
84
 
85
      TST_Ada_To_COBOL : COBOL.COBOL_Character :=
86
                                          COBOL.Ada_To_COBOL (Character'First);
87
 
88
      TST_COBOL_To_Ada : Character :=
89
                              COBOL.COBOL_To_Ada (COBOL.COBOL_Character'First);
90
 
91
      --  assignment to make sure it is an array of  COBOL_Character
92
      TST_Alphanumeric : COBOL.Alphanumeric (1..5) :=
93
                                             (others => TST_COBOL_Character);
94
 
95
 
96
      --  assignment to make sure it is an array of  COBOL_Character
97
      TST_Numeric : COBOL.Numeric (1..5) := (others => TST_COBOL_Character);
98
 
99
 
100
      procedure Collect_All_Calls is
101
 
102
         CAC_Alphanumeric : COBOL.Alphanumeric(1..5) :=
103
                              COBOL.To_COBOL("abcde");
104
         CAC_String       : String (1..5) := "vwxyz";
105
         CAC_Natural      : natural       := 0;
106
 
107
      begin
108
 
109
         CAC_Alphanumeric := COBOL.To_COBOL (CAC_String);
110
         CAC_String := COBOL.To_Ada  (CAC_Alphanumeric);
111
 
112
         COBOL.To_COBOL (CAC_String, CAC_Alphanumeric, CAC_Natural);
113
         COBOL.To_Ada (CAC_Alphanumeric, CAC_String, CAC_Natural);
114
 
115
         raise COBOL.Conversion_Error;
116
 
117
      end Collect_All_Calls;
118
 
119
 
120
 
121
      --  Formats for COBOL data representations
122
 
123
      TST_Unsigned   : COBOL.Display_Format := COBOL.Unsigned;
124
      TST_Leading_Separate : COBOL.Display_Format := COBOL.Leading_Separate;
125
      TST_Trailing_Separate : COBOL.Display_Format := COBOL.Trailing_Separate;
126
      TST_Leading_Nonseparate  : COBOL.Display_Format :=
127
                                                   COBOL.Leading_Nonseparate;
128
      TST_Trailing_Nonseparate : COBOL.Display_Format :=
129
                                                   COBOL.Trailing_Nonseparate;
130
 
131
 
132
      TST_High_Order_First  : COBOL.Binary_Format := COBOL.High_Order_First;
133
      TST_Low_Order_First   : COBOL.Binary_Format := COBOL.Low_Order_First;
134
      TST_Native_Binary     : COBOL.Binary_Format := COBOL.Native_Binary;
135
 
136
 
137
      TST_Packed_Unsigned   : COBOL.Packed_Format := COBOL.Packed_Unsigned;
138
      TST_Packed_Signed     : COBOL.Packed_Format := COBOL.Packed_Signed;
139
 
140
 
141
      --  Types for external representation of COBOL binary data
142
 
143
      TST_Byte_Array : COBOL.Byte_Array(1..5) := (others => COBOL.Byte'First);
144
 
145
      -- Now instantiate one version of the generic
146
      --
147
      type bx4001_Decimal is delta 0.1 digits 5;
148
      package bx4001_conv is new COBOL.Decimal_Conversions (bx4001_Decimal);
149
 
150
      procedure Collect_All_Generic_Calls is
151
         CAGC_natural        : natural;
152
         CAGC_Display_Format : COBOL.Display_Format;
153
         CAGC_Boolean        : Boolean;
154
         CAGC_Numeric        : COBOL.Numeric(1..5);
155
         CAGC_Num            : bx4001_Decimal;
156
         CAGC_Packed_Decimal : COBOL.Packed_Decimal (1..5);
157
         CAGC_Packed_Format  : COBOL.Packed_Format;
158
         CAGC_Byte_Array     : COBOL.Byte_Array (1..5);
159
         CAGC_Binary_Format  : COBOL.Binary_Format;
160
         CAGC_Binary         : COBOL.Binary;
161
         CAGC_Long_Binary    : COBOL.Long_Binary;
162
      begin
163
 
164
         --  Display Formats: data values are represented as Numeric
165
 
166
         CAGC_Boolean := bx4001_conv.Valid (CAGC_Numeric, CAGC_Display_Format);
167
         CAGC_Natural := bx4001_conv.Length (CAGC_Display_Format);
168
 
169
         CAGC_Num := bx4001_conv.To_Decimal
170
                                       (CAGC_Numeric, CAGC_Display_Format);
171
         CAGC_Numeric := bx4001_conv.To_Display
172
                                       (CAGC_Num, CAGC_Display_Format);
173
 
174
 
175
         --  Packed Formats: data values are represented as Packed_Decimal
176
 
177
         CAGC_Boolean := bx4001_conv.Valid
178
                                    (CAGC_Packed_Decimal, CAGC_Packed_Format);
179
 
180
         CAGC_Natural := bx4001_conv.Length (CAGC_Packed_Format);
181
 
182
         CAGC_Num := bx4001_conv.To_Decimal
183
                                    (CAGC_Packed_Decimal, CAGC_Packed_Format);
184
 
185
         CAGC_Packed_Decimal := bx4001_conv.To_Packed
186
                                    (CAGC_Num, CAGC_Packed_Format);
187
 
188
 
189
         --  Binary Formats: external data values are represented as
190
         --  Byte_Array
191
 
192
         CAGC_Boolean := bx4001_conv.Valid
193
                                    (CAGC_Byte_Array, CAGC_Binary_Format);
194
 
195
         CAGC_Natural := bx4001_conv.Length (CAGC_Binary_Format);
196
         CAGC_Num := bx4001_conv.To_Decimal
197
                                    (CAGC_Byte_Array, CAGC_Binary_Format);
198
 
199
         CAGC_Byte_Array := bx4001_conv.To_Binary (CAGC_Num, CAGC_Binary_Format);
200
 
201
 
202
         --  Internal Binary formats: data values are of type
203
         --  Binary/Long_Binary
204
 
205
         CAGC_Num := bx4001_conv.To_Decimal (CAGC_Binary);
206
         CAGC_Num := bx4001_conv.To_Decimal (CAGC_Long_Binary);
207
 
208
         CAGC_Binary       := bx4001_conv.To_Binary (CAGC_Num);
209
         CAGC_Long_Binary  := bx4001_conv.To_Long_Binary (CAGC_Num);
210
 
211
 
212
      end Collect_All_Generic_Calls;
213
 
214
 
215
   begin    -- encapsulation
216
 
217
      if COBOL.Byte'First /= 0     or
218
         COBOL.Byte'Last  /=  (2 ** COBOL.COBOL_Character'Size) - 1 then
219
            Report.Failed ("Byte is incorrectly defined");
220
      end if;
221
 
222
      if  COBOL.Decimal_Element'First /= 0 then
223
         Report.Failed ("Decimal_Element is incorrectly defined");
224
      end if;
225
 
226
   end;     -- encapsulation
227
 
228
   Report.Result;
229
 
230
end CXB4001;

powered by: WebSVN 2.1.0

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