3 -- Grant of Unlimited Rights
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.
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19 -- DISCLOSED ARE AS IS. THE ACAA 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.
27 -- Check that an expression in a per-object discriminant constraint which is
28 -- part of a named association is evaluated once for each association.
29 -- (Defect Report 8652/0002, as reflected in Technical Corrigendum 1,
33 -- 9 FEB 2001 PHL Initial version.
34 -- 29 JUN 2002 RLB Readied for release.
43 F_Val
: Integer := Ident_Int
(0);
45 function F
return Integer is
47 F_Val
:= F_Val
+ Ident_Int
(1);
53 type R2
(D0
: Integer; D1
: access R1
; D2
: Integer; D3
: Integer) is
58 C
: R2
(D1
=> R1
'Access, D0 | D2 | D3
=> F
);
62 Test
("C380002", "Check that an expression in a per-object discriminant " &
63 "constraint which is part of a named association is " &
64 "evaluated once for each association");
66 if not Equal
(F_Val
, 3) then
67 Failed
("Expression not evaluated the proper number of times");