-- c732AJC.a -- -- Grant of Unlimited Rights -- -- The Ada Conformity Assessment Authority (ACAA) holds unlimited -- rights in the software and documentation contained herein. Unlimited -- rights are the same as those granted by the U.S. Government for older -- parts of the Ada Conformity Assessment Test Suite, and are defined -- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA -- intends to confer upon all recipients unlimited rights equal to those -- held by the ACAA. These rights include rights to use, duplicate, -- release or disclose the released technical data and computer software -- in whole or in part, in any manner and for any purpose whatsoever, and -- to have or permit others to do so. -- -- DISCLAIMER -- -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR -- DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A -- PARTICULAR PURPOSE OF SAID MATERIAL. -- -- Notice -- -- The ACAA has created and maintains the Ada Conformity Assessment Test -- Suite for the purpose of conformity assessments conducted in accordance -- with the International Standard ISO/IEC 18009 - Ada: Conformity -- assessment of a language processor. This test suite should not be used -- to make claims of conformance unless used in accordance with -- ISO/IEC 18009 and any applicable ACAA procedures. --* -- OBJECTIVE: -- Check that an assertion error is raised when the policy requires -- checks and there is a parameter with a part of a type with an -- invariant that does not hold true, but not when the invariant does -- hold true, constrained array version. -- -- TEST DESCRIPTION: -- This test is based on a program for generating "Diagrams" for -- bellringing. The type invariant is that each bell occurs once and only -- once. -- -- An invariant check fails if any enabled invariant expression for the -- type evaluates to False. For this test, there is only one invariant -- expression (given in the foundation) and it is enabled. (It does not -- matter if invariants are enabled in this client subprogram; it is -- the state for the place where the invariant is defined that matters.) -- -- In this test, we check invariant checks that fail for: -- (1) A return object of the type. -- -- CHANGE HISTORY: -- 25 Dec 14 JAC Initial pre-release version. -- 20 Jan 15 JAC Second pre-release version. -- --! with Ada.Assertions; with C732AJC_A; with C732AJC_B; with F732A00; with Report; procedure C732AJC is pragma Assertion_Policy (Check); package Bells renames C732AJC_B; procedure Test_Invalid_Function_Result is procedure Do_Invalid_Function_Result is My_Invalid_Change : constant Bells.Change_Constrained_With_Key_Type := Bells.Invalid_Change; begin if F732A00.Each_Bell_Occurs_Once (C732AJC_A.Change_Tagged_Record_Constrained_Type (My_Invalid_Change).Change) then Report.Failed ("Incorrect explicit initialisation - invalid change"); -- Mainly to use the object so it isn't subject to dead object -- elimination. end if; end Do_Invalid_Function_Result; begin declare begin Do_Invalid_Function_Result; Report.Failed ("Invalid function result should have raised Assertion_Eerror"); exception when Ada.Assertions.Assertion_Error => null; -- Invariant check failed, as expected. end; end Test_Invalid_Function_Result; procedure Test_Valid_Function_Result is My_Change : constant Bells.Change_Constrained_With_Key_Type := Bells.Rounds; begin if not F732A00.Each_Bell_Occurs_Once (C732AJC_A.Change_Tagged_Record_Constrained_Type (My_Change).Change) then Report.Failed ("Incorrect explicit initialisation - valid change"); -- Mainly to use the object so it isn't subject to dead object -- elimination. end if; end Test_Valid_Function_Result; begin Report.Test ("C732AJC", "Check that an assertion error is raised when the policy requires" & " checks and there is a parameter with a part of a type with an" & " invariant that does not hold true, but not when the invariant does" & " hold true, constrained array version"); Test_Invalid_Function_Result; Test_Valid_Function_Result; Report.Result; end C732AJC;