Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c3/c3900050.a @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 -- C3900050.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 -- See C3900053.AM. | |
28 -- | |
29 -- TEST DESCRIPTION: | |
30 -- See C3900053.AM. | |
31 -- | |
32 -- TEST FILES: | |
33 -- This test consists of the following files: | |
34 -- | |
35 -- => C3900050.A | |
36 -- C3900051.A | |
37 -- C3900052.A | |
38 -- C3900053.AM | |
39 -- | |
40 -- CHANGE HISTORY: | |
41 -- 06 Dec 94 SAIC ACVC 2.0 | |
42 -- 15 May 96 SAIC ACVC 2.1: Modified prologue. Added pragma Elaborate | |
43 -- for Ada.Calendar. | |
44 -- | |
45 --! | |
46 | |
47 with Ada.Calendar; | |
48 pragma Elaborate (Ada.Calendar); | |
49 | |
50 package C3900050 is -- Alert system abstraction. | |
51 | |
52 -- Declarations used by component Arrival_Time. | |
53 | |
54 Default_Time : constant Ada.Calendar.Time := | |
55 Ada.Calendar.Time_Of (1901, 1, 1); | |
56 Alert_Time : constant Ada.Calendar.Time := | |
57 Ada.Calendar.Time_Of (1991, 6, 15); | |
58 | |
59 | |
60 -- Declarations used by component Display_On and procedure Display. | |
61 | |
62 type Device_Enum is (Null_Device, Teletype, Console, Big_Screen); | |
63 type Display_Counters is array (Device_Enum) of Natural; | |
64 | |
65 Display_Count_For : Display_Counters := (others => 0); | |
66 | |
67 | |
68 | |
69 type Alert_Type is tagged private; -- Root tagged type. | |
70 | |
71 procedure Set_Display (A : in out Alert_Type; -- To be inherited by | |
72 D : in Device_Enum); -- all derivatives. | |
73 | |
74 procedure Display (A : in Alert_Type); -- To be inherited by | |
75 -- all derivatives. | |
76 | |
77 procedure Handle (A : in out Alert_Type); -- To be overridden by | |
78 -- all derivatives. | |
79 | |
80 | |
81 -- The following functions are needed to verify the values of the | |
82 -- root tagged type's private components. | |
83 | |
84 function Get_Time (A: Alert_Type) return Ada.Calendar.Time; | |
85 | |
86 function Get_Display (A: Alert_Type) return Device_Enum; | |
87 | |
88 function Initial_Values_Okay (A : in Alert_Type) | |
89 return Boolean; | |
90 | |
91 function Bad_Final_Values (A : in Alert_Type) | |
92 return Boolean; | |
93 | |
94 private | |
95 | |
96 type Alert_Type is tagged record -- Root tagged type. | |
97 Arrival_Time : Ada.Calendar.Time := Default_Time; | |
98 Display_On : Device_Enum := Null_Device; | |
99 end record; | |
100 | |
101 | |
102 end C3900050; | |
103 | |
104 | |
105 --==================================================================-- | |
106 | |
107 | |
108 package body C3900050 is -- Alert system abstraction. | |
109 | |
110 | |
111 procedure Set_Display (A : in out Alert_Type; | |
112 D : in Device_Enum) is | |
113 begin | |
114 A.Display_On := D; | |
115 end Set_Display; | |
116 | |
117 | |
118 procedure Display (A : in Alert_Type) is | |
119 begin | |
120 Display_Count_For (A.Display_On) := Display_Count_For (A.Display_On) + 1; | |
121 end Display; | |
122 | |
123 | |
124 procedure Handle (A : in out Alert_Type) is | |
125 begin | |
126 A.Arrival_Time := Alert_Time; | |
127 Display (A); | |
128 end Handle; | |
129 | |
130 | |
131 function Get_Time (A: Alert_Type) return Ada.Calendar.Time is | |
132 begin | |
133 return A.Arrival_Time; | |
134 end Get_Time; | |
135 | |
136 | |
137 function Get_Display (A: Alert_Type) return Device_Enum is | |
138 begin | |
139 return A.Display_On; | |
140 end Get_Display; | |
141 | |
142 | |
143 function Initial_Values_Okay (A : in Alert_Type) return Boolean is | |
144 begin | |
145 return (A = (Arrival_Time => Default_Time, -- Check "=" operator | |
146 Display_On => Null_Device)); -- availability. | |
147 end Initial_Values_Okay; -- Aggregate with | |
148 -- named associations. | |
149 | |
150 function Bad_Final_Values (A : in Alert_Type) return Boolean is | |
151 begin | |
152 return (A /= (Alert_Time, Null_Device)); -- Check "/=" operator | |
153 -- availability. | |
154 end Bad_Final_Values; -- Aggregate with | |
155 -- positional assoc. | |
156 | |
157 end C3900050; |