1-- C910003.A 2-- 3-- Grant of Unlimited Rights 4-- 5-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and 6-- F08630-91-C-0015, the U.S. Government obtained unlimited rights in the 7-- software and documentation contained herein. Unlimited rights are 8-- defined in DFAR 252.227-7013(a)(19). By making this public release, 9-- the Government intends to confer upon all recipients unlimited rights 10-- equal to those held by the Government. These rights include rights to 11-- use, duplicate, release or disclose the released technical data and 12-- computer software in whole or in part, in any manner and for any purpose 13-- whatsoever, and to have or permit others to do so. 14-- 15-- DISCLAIMER 16-- 17-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 18-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 19-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE 20-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 21-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 22-- PARTICULAR PURPOSE OF SAID MATERIAL. 23--* 24-- 25-- OBJECTIVE: 26-- Check that task discriminants that have an access subtype may be 27-- dereferenced. 28-- 29-- Note that discriminants in Ada 83 never can be dereferenced with 30-- selection or indexing, as they cannot have an access type. 31-- 32-- TEST DESCRIPTION: 33-- A protected object is defined to create a simple buffer. 34-- Two task types are defined, one to put values into the buffer, 35-- and one to remove them. The tasks are passed a buffer object as 36-- a discriminant with an access subtype. The producer task type includes 37-- a discriminant to determine the values to product. The consumer task 38-- type includes a value to save the results. 39-- Two producer and one consumer tasks are declared, and the results 40-- are checked. 41-- 42-- CHANGE HISTORY: 43-- 10 Mar 99 RLB Created test. 44-- 45--! 46 47package C910003_Pack is 48 49 type Item_Type is range 1 .. 100; -- In a real application, this probably 50 -- would be a record type. 51 52 type Item_Array is array (Positive range <>) of Item_Type; 53 54 protected type Buffer is 55 entry Put (Item : in Item_Type); 56 entry Get (Item : out Item_Type); 57 function TC_Items_Buffered return Item_Array; 58 private 59 Saved_Item : Item_Type; 60 Empty : Boolean := True; 61 TC_Items : Item_Array (1 .. 10); 62 TC_Last : Natural := 0; 63 end Buffer; 64 65 type Buffer_Access_Type is access Buffer; 66 67 PRODUCE_COUNT : constant := 2; -- Number of items to produce. 68 69 task type Producer (Buffer_Access : Buffer_Access_Type; 70 Start_At : Item_Type); 71 -- Produces PRODUCE_COUNT items. Starts when activated. 72 73 type TC_Item_Array_Access_Type is access Item_Array (1 .. PRODUCE_COUNT*2); 74 75 task type Consumer (Buffer_Access : Buffer_Access_Type; 76 Results : TC_Item_Array_Access_Type) is 77 -- Stores PRODUCE_COUNT*2 items consumed in Results. Starts when 78 -- activated. 79 entry Wait_until_Done; 80 end Consumer; 81 82end C910003_Pack; 83 84 85with Report; 86package body C910003_Pack is 87 88 protected body Buffer is 89 entry Put (Item : in Item_Type) when Empty is 90 begin 91 Empty := False; 92 Saved_Item := Item; 93 TC_Last := TC_Last + 1; 94 TC_Items(TC_Last) := Item; 95 end Put; 96 97 entry Get (Item : out Item_Type) when not Empty is 98 begin 99 Empty := True; 100 Item := Saved_Item; 101 end Get; 102 103 function TC_Items_Buffered return Item_Array is 104 begin 105 return TC_Items(1..TC_Last); 106 end TC_Items_Buffered; 107 108 end Buffer; 109 110 111 task body Producer is 112 -- Produces PRODUCE_COUNT items. Starts when activated. 113 begin 114 for I in 1 .. Report.Ident_Int(PRODUCE_COUNT) loop 115 Buffer_Access.Put (Start_At + (Item_Type(I)-1)*2); 116 end loop; 117 end Producer; 118 119 120 task body Consumer is 121 -- Stores PRODUCE_COUNT*2 items consumed in Results. Starts when 122 -- activated. 123 begin 124 for I in 1 .. Report.Ident_Int(PRODUCE_COUNT*2) loop 125 Buffer_Access.Get (Results (I)); 126 -- Buffer_Access and Results are both dereferenced. 127 end loop; 128 129 -- Check the results (and function call with a prefix dereference). 130 if Results.all(Report.Ident_Int(1)) /= Buffer_Access.all.TC_Items_Buffered(Report.Ident_Int(1)) then 131 Report.Failed ("First item mismatch"); 132 end if; 133 if Results(Report.Ident_Int(2)) /= Buffer_Access.TC_Items_Buffered(Report.Ident_Int(2)) then 134 Report.Failed ("Second item mismatch"); 135 end if; 136 accept Wait_until_Done; -- Tell main that we're done. 137 end Consumer; 138 139end C910003_Pack; 140 141 142with Report; 143with C910003_Pack; 144 145procedure C910003 is 146 147begin -- C910003 148 149 Report.Test ("C910003", "Check that tasks discriminants of access types can be dereferenced"); 150 151 152 declare -- encapsulate the test 153 154 Buffer_Access : C910003_Pack.Buffer_Access_Type := 155 new C910003_Pack.Buffer; 156 157 TC_Results : C910003_Pack.TC_Item_Array_Access_Type := 158 new C910003_Pack.Item_Array (1 .. C910003_Pack.PRODUCE_COUNT*2); 159 160 Producer_1 : C910003_Pack.Producer (Buffer_Access, 12); 161 Producer_2 : C910003_Pack.Producer (Buffer_Access, 23); 162 163 Consumer : C910003_Pack.Consumer (Buffer_Access, TC_Results); 164 165 use type C910003_Pack.Item_Array; -- For /=. 166 167 begin 168 Consumer.Wait_until_Done; 169 if TC_Results.all /= Buffer_Access.TC_Items_Buffered then 170 Report.Failed ("Different items buffered than returned - Main"); 171 end if; 172 if (TC_Results.all /= (12, 14, 23, 25) and 173 TC_Results.all /= (12, 23, 14, 25) and 174 TC_Results.all /= (12, 23, 25, 14) and 175 TC_Results.all /= (23, 12, 14, 25) and 176 TC_Results.all /= (23, 12, 25, 14) and 177 TC_Results.all /= (23, 25, 12, 14)) then 178 -- Above are the only legal results. 179 Report.Failed ("Wrong results"); 180 end if; 181 end; -- encapsulation 182 183 Report.Result; 184 185end C910003; 186