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/] [support/] [fdd2a00.a] - Blame information for rev 316

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

Line No. Rev Author Line
1 294 jeremybenn
-- FDD2A00.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
-- FOUNDATION DESCRIPTION:
27
--      This foundation provides the basis for testing user-defined stream
28
--      attributes. It provides operations which count calls to stream
29
--      attributes.
30
--
31
-- CHANGE HISTORY:
32
--    30 JUL 2001   PHL   Initial version.
33
--     5 DEC 2001   RLB   Reformatted for ACATS.
34
--
35
 
36
with Ada.Streams;
37
use Ada.Streams;
38
package FDD2A00 is
39
 
40
    type Kinds is (Read, Write, Input, Output);
41
    type Counts is array (Kinds) of Natural;
42
 
43
 
44
    type My_Stream (Size : Stream_Element_Count) is new Root_Stream_Type with
45
        record
46
            First : Stream_Element_Offset := 1;
47
            Last : Stream_Element_Offset := 0;
48
            Contents : Stream_Element_Array (1 .. Size);
49
        end record;
50
 
51
    procedure Clear (Stream : in out My_Stream);
52
 
53
    procedure Read (Stream : in out My_Stream;
54
                    Item : out Stream_Element_Array;
55
                    Last : out Stream_Element_Offset);
56
 
57
    procedure Write (Stream : in out My_Stream; Item : in Stream_Element_Array);
58
 
59
 
60
    generic
61
        type T (<>) is limited private;
62
        with procedure Actual_Write
63
                          (Stream : access Root_Stream_Type'Class; Item : T);
64
        with function Actual_Input
65
                         (Stream : access Root_Stream_Type'Class) return T;
66
        with procedure Actual_Read (Stream : access Root_Stream_Type'Class;
67
                                    Item : out T);
68
        with procedure Actual_Output
69
                          (Stream : access Root_Stream_Type'Class; Item : T);
70
    package Counting_Stream_Ops is
71
 
72
        procedure Write (Stream : access Root_Stream_Type'Class; Item : T);
73
        function Input (Stream : access Root_Stream_Type'Class) return T;
74
        procedure Read (Stream : access Root_Stream_Type'Class; Item : out T);
75
        procedure Output (Stream : access Root_Stream_Type'Class; Item : T);
76
 
77
        function Get_Counts return Counts;
78
 
79
    end Counting_Stream_Ops;
80
 
81
end FDD2A00;
82
package body FDD2A00 is
83
 
84
    procedure Clear (Stream : in out My_Stream) is
85
    begin
86
        Stream.First := 1;
87
        Stream.Last := 0;
88
    end Clear;
89
 
90
    procedure Read (Stream : in out My_Stream;
91
                    Item : out Stream_Element_Array;
92
                    Last : out Stream_Element_Offset) is
93
    begin
94
        if Item'Length >= Stream.Last - Stream.First + 1 then
95
            Item (Item'First .. Item'First + Stream.Last - Stream.First) :=
96
               Stream.Contents (Stream.First .. Stream.Last);
97
            Last := Item'First + Stream.Last - Stream.First;
98
            Stream.First := Stream.Last + 1;
99
        else
100
            Item := Stream.Contents (Stream.First ..
101
                                        Stream.First + Item'Length - 1);
102
            Last := Item'Last;
103
            Stream.First := Stream.First + Item'Length;
104
        end if;
105
    end Read;
106
 
107
    procedure Write (Stream : in out My_Stream;
108
                     Item : in Stream_Element_Array) is
109
    begin
110
        Stream.Contents (Stream.Last + 1 .. Stream.Last + Item'Length) := Item;
111
        Stream.Last := Stream.Last + Item'Length;
112
    end Write;
113
 
114
 
115
    package body Counting_Stream_Ops is
116
        Cnts : Counts := (others => 0);
117
 
118
        procedure Write (Stream : access Root_Stream_Type'Class; Item : T) is
119
        begin
120
            Cnts (Write) := Cnts (Write) + 1;
121
            Actual_Write (Stream, Item);
122
        end Write;
123
 
124
        function Input (Stream : access Root_Stream_Type'Class) return T is
125
        begin
126
            Cnts (Input) := Cnts (Input) + 1;
127
            return Actual_Input (Stream);
128
        end Input;
129
 
130
        procedure Read (Stream : access Root_Stream_Type'Class; Item : out T) is
131
        begin
132
            Cnts (Read) := Cnts (Read) + 1;
133
            Actual_Read (Stream, Item);
134
        end Read;
135
 
136
        procedure Output (Stream : access Root_Stream_Type'Class; Item : T) is
137
        begin
138
            Cnts (Output) := Cnts (Output) + 1;
139
            Actual_Output (Stream, Item);
140
        end Output;
141
 
142
        function Get_Counts return Counts is
143
        begin
144
            return Cnts;
145
        end Get_Counts;
146
 
147
    end Counting_Stream_Ops;
148
 
149
end FDD2A00;

powered by: WebSVN 2.1.0

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