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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cd/] [cdd2001.a] - Blame information for rev 154

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CDD2001.A
2
--
3
--                             Grant of Unlimited Rights
4
--
5
--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
6
--     rights in the software and documentation contained herein. Unlimited
7
--     rights are the same as those granted by the U.S. Government for older
8
--     parts of the Ada Conformity Assessment Test Suite, and are defined
9
--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
10
--     intends to confer upon all recipients unlimited rights equal to those
11
--     held by the ACAA. These rights include rights to use, duplicate,
12
--     release or disclose the released technical data and computer software
13
--     in whole or in part, in any manner and for any purpose whatsoever, and
14
--     to have or permit others 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 default implementation of Read and Input raise End_Error
28
--    if the end of stream is reached before the reading of a value is
29
--    completed.  (Defect Report 8652/0045,
30
--    Technical Corrigendum 13.13.2(35.1/1)).
31
--
32
-- CHANGE HISTORY:
33
--    12 FEB 2001   PHL   Initial version.
34
--    29 JUN 2001   RLB   Reformatted for ACATS.
35
--
36
--!
37
 
38
with Ada.Streams;
39
use Ada.Streams;
40
package CDD2001_0 is
41
 
42
    type My_Stream (Size : Stream_Element_Count) is new Root_Stream_Type with
43
        record
44
            First : Stream_Element_Offset := 1;
45
            Last : Stream_Element_Offset := 0;
46
            Contents : Stream_Element_Array (1 .. Size);
47
        end record;
48
 
49
    procedure Clear (Stream : in out My_Stream);
50
 
51
    procedure Read (Stream : in out My_Stream;
52
                    Item : out Stream_Element_Array;
53
                    Last : out Stream_Element_Offset);
54
 
55
    procedure Write (Stream : in out My_Stream; Item : in Stream_Element_Array);
56
 
57
end CDD2001_0;
58
 
59
package body CDD2001_0 is
60
 
61
    procedure Clear (Stream : in out My_Stream) is
62
    begin
63
        Stream.First := 1;
64
        Stream.Last := 0;
65
    end Clear;
66
 
67
    procedure Read (Stream : in out My_Stream;
68
                    Item : out Stream_Element_Array;
69
                    Last : out Stream_Element_Offset) is
70
    begin
71
        if Item'Length >= Stream.Last - Stream.First + 1 then
72
            Item (Item'First .. Item'First + Stream.Last - Stream.First) :=
73
               Stream.Contents (Stream.First .. Stream.Last);
74
            Last := Item'First + Stream.Last - Stream.First;
75
            Stream.First := Stream.Last + 1;
76
        else
77
            Item := Stream.Contents (Stream.First ..
78
                                        Stream.First + Item'Length - 1);
79
            Last := Item'Last;
80
            Stream.First := Stream.First + Item'Length;
81
        end if;
82
    end Read;
83
 
84
    procedure Write (Stream : in out My_Stream;
85
                     Item : in Stream_Element_Array) is
86
    begin
87
        Stream.Contents (Stream.Last + 1 .. Stream.Last + Item'Length) := Item;
88
        Stream.Last := Stream.Last + Item'Length;
89
    end Write;
90
 
91
end CDD2001_0;
92
 
93
with Ada.Exceptions;
94
use Ada.Exceptions;
95
with CDD2001_0;
96
use CDD2001_0;
97
with Io_Exceptions;
98
use Io_Exceptions;
99
with Report;
100
use Report;
101
procedure CDD2001 is
102
 
103
    subtype Int is Integer range -20 .. 20;
104
 
105
    type R (D : Int) is
106
        record
107
            C1 : Character := Ident_Char ('a');
108
            case D is
109
                when 0 .. 20 =>
110
                    C2 : String (1 .. D) := (others => Ident_Char ('b'));
111
                when others =>
112
                    C3, C4 : Float := Float (-D);
113
            end case;
114
        end record;
115
 
116
    S : aliased My_Stream (200);
117
 
118
begin
119
    Test
120
       ("CDD2001",
121
           "Check that the default implementation of Read and Input " &
122
           "raise End_Error if the end of stream is reached before the " &
123
           "reading of a value is completed");
124
 
125
    Read:
126
        declare
127
            X : R (Ident_Int (13));
128
        begin
129
            Clear (S);
130
 
131
            -- A complete object.
132
            R'Write (S'Access, X);
133
            X.C1 := Ident_Char ('A');
134
            X.C2 := (others => Ident_Char ('B'));
135
            R'Read (S'Access, X);
136
            if X.C1 /= Ident_Char ('a') or X.C2 /=
137
                                              (1 .. 13 => Ident_Char ('b')) then
138
                Failed ("Read did not produce the expected result");
139
            end if;
140
 
141
            Clear (S);
142
 
143
            -- Not enough data.
144
            Character'Write (S'Access, 'a');
145
            String'Write (S'Access, "bbb");
146
 
147
            begin
148
                R'Read (S'Access, X);
149
                Failed
150
                   ("No exception raised when the end of stream is reached " &
151
                    "before the reading of a value is completed - 1");
152
            exception
153
                when End_Error =>
154
                    null;
155
                when E: others =>
156
                    Failed ("Wrong Exception " & Exception_Name (E) &
157
                            " - " & Exception_Information (E) &
158
                            " - " & Exception_Message (E) & " - 1");
159
            end;
160
 
161
        end Read;
162
 
163
    Input:
164
        declare
165
            X : R (Ident_Int (-11));
166
        begin
167
            Clear (S);
168
 
169
            -- A complete object.
170
            R'Output (S'Access, X);
171
            X.C1 := Ident_Char ('A');
172
            X.C3 := 4.0;
173
            X.C4 := 5.0;
174
            X := R'Input (S'Access);
175
            if X.C1 /= Ident_Char ('a') or X.C3 /= 11.0 or X.C4 /= 11.0 then
176
                Failed ("Input did not produce the expected result");
177
            end if;
178
 
179
            Clear (S);
180
 
181
            -- Not enough data.
182
            Integer'Output (S'Access, Ident_Int (-11)); -- The discriminant
183
            Character'Output (S'Access, 'a');
184
            Float'Output (S'Access, 11.0);
185
 
186
            begin
187
                X := R'Input (S'Access);
188
                Failed
189
                   ("No exception raised when the end of stream is reached " &
190
                    "before the reading of a value is completed - 2");
191
            exception
192
                when End_Error =>
193
                    null;
194
                when E: others =>
195
                    Failed ("Wrong exception " & Exception_Name (E) &
196
                            " - " & Exception_Message (E) & " - 2");
197
            end;
198
 
199
        end Input;
200
 
201
    Result;
202
end CDD2001;
203
 

powered by: WebSVN 2.1.0

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