-- CXH1001.A -- -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained -- unlimited rights in the software and documentation contained herein. -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making -- this public release, the Government intends to confer upon all -- recipients unlimited rights equal to those held by the Government. -- 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 GOVERNMENT 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. --* -- -- OBJECTIVE -- Check pragma Normalize_Scalars. -- Check that this configuration pragma causes uninitialized scalar -- objects to be set to a predictable value. Check that multiple -- compilation units are affected. Check for uninitialized scalar -- objects that are subcomponents of composite objects, unassigned -- out parameters, objects that have been allocated without an initial -- value, and objects that are stand alone. -- -- TEST DESCRIPTION -- The test requires that the configuration pragma Normalize_Scalars -- be processed. It then defines a few scalar types (some enumeration, -- some integer) in a few packages. The scalar types are designed such -- that the representation will easily allow for an out of range value. -- Unchecked_Conversion and the 'Valid attribute are both used to verify -- that the default values of the various kinds of objects are indeed -- invalid for the type. -- -- Note that this test relies on having uninitialized objects, compilers -- may generate several warnings to this effect. -- -- SPECIAL REQUIREMENTS -- The implementation must process configuration pragmas which -- are not part of any Compilation Unit; the method employed -- is implementation defined. -- -- APPLICABILITY CRITERIA: -- This test is only applicable for a compiler attempting validation -- for the Safety and Security Annex. -- -- -- CHANGE HISTORY: -- 26 OCT 95 SAIC Initial version -- 04 NOV 96 SAIC Added cases, upgraded commentary -- --! ---------------------------- CONFIGURATION PRAGMAS ----------------------- pragma Normalize_Scalars; -- OK -- configuration pragma ------------------------ END OF CONFIGURATION PRAGMAS -------------------- ----------------------------------------------------------------- CXH1001_0 with Impdef.Annex_H; with Unchecked_Conversion; package CXH1001_0 is package Imp_H renames Impdef.Annex_H; use type Imp_H.Small_Number; use type Imp_H.Scalar_To_Normalize; Global_Object : Imp_H.Scalar_To_Normalize; -- if the pragma is in effect, this should come up with the predictable -- value Global_Number : Imp_H.Small_Number; -- if the pragma is in effect, this should come up with the predictable -- value procedure Package_Check; type Num is range 0..2**Imp_H.Scalar_To_Normalize'Size-1; for Num'Size use Imp_H.Scalar_To_Normalize'Size; function STN_2_Num is new Unchecked_Conversion( Imp_H.Scalar_To_Normalize, Num ); Small_Last : constant Integer := Integer(Imp_H.Small_Number'Last); end CXH1001_0; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- with Report; package body CXH1001_0 is procedure Heap_Check( A_Value : access Imp_H.Scalar_To_Normalize; A_Number : access Imp_H.Small_Number ) is Value : Num; Number : Integer; begin if A_Value.all'Valid then Value := STN_2_Num ( A_Value.all ); if Imp_H.Default_For_Scalar_To_Normalize_Is_In_Range then if Imp_H.Scalar_To_Normalize'Val(Value) /= Imp_H.Default_For_Scalar_To_Normalize then Report.Failed("Implicit initial value for local variable is not " & "the predicted value"); end if; else if Value in 0 .. Imp_H.Scalar_To_Normalize'Pos(Imp_H.Scalar_To_Normalize'Last) then Report.Failed("Implicit initial value for local variable is a " & "value of the type"); end if; end if; end if; if A_Number.all'Valid then Number := Integer( A_Number.all ); if Imp_H.Default_For_Small_Number_Is_In_Range then if Global_Number /= Imp_H.Default_For_Small_Number then Report.Failed("Implicit initial value for number is not " & "the predicted value"); end if; else if Integer( Global_Number ) in 0 .. Report.Ident_Int(Small_Last) then Report.Failed("Implicit initial value for number is a " & "value of the type"); end if; end if; end if; end Heap_Check; procedure Package_Check is Value : Num; Number : Integer; begin if Global_Object'Valid then Value := STN_2_Num ( Global_Object ); if Imp_H.Default_For_Scalar_To_Normalize_Is_In_Range then if Imp_H.Scalar_To_Normalize'Val(Value) /= Imp_H.Default_For_Scalar_To_Normalize then Report.Failed("Implicit initial value for local variable is not " & "the predicted value"); end if; else if Value in 0 .. Imp_H.Scalar_To_Normalize'Pos(Imp_H.Scalar_To_Normalize'Last) then Report.Failed("Implicit initial value for local variable is a " & "value of the type"); end if; end if; end if; if Global_Number'Valid then Number := Integer( Global_Number ); if Imp_H.Default_For_Small_Number_Is_In_Range then if Global_Number /= Imp_H.Default_For_Small_Number then Report.Failed("Implicit initial value for number is not " & "the predicted value"); end if; else if Integer( Global_Number ) in 0 .. Report.Ident_Int(Small_Last) then Report.Failed("Implicit initial value for number is a " & "value of the type"); end if; end if; end if; Heap_Check( new Imp_H.Scalar_To_Normalize, new Imp_H.Small_Number ); end Package_Check; end CXH1001_0; ----------------------------------------------------------------- CXH1001_1 with Unchecked_Conversion; package CXH1001_0.CXH1001_1 is -- kill as many birds as possible with a single stone: -- embed a protected object in the body of a child package, -- checks the multiple compilation unit case, -- and part of the subcomponent case. protected Thingy is procedure Check_Embedded_Values; private Hidden_Object : Imp_H.Scalar_To_Normalize; -- not initialized Hidden_Number : Imp_H.Small_Number; -- not initialized end Thingy; end CXH1001_0.CXH1001_1; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- with Report; package body CXH1001_0.CXH1001_1 is Childs_Object : Imp_H.Scalar_To_Normalize; -- not initialized protected body Thingy is procedure Check_Embedded_Values is begin if Imp_H.Default_For_Scalar_To_Normalize_Is_In_Range then if Childs_Object /= Imp_H.Default_For_Scalar_To_Normalize then Report.Failed("Implicit initial value for child object is not " & "the predicted value"); end if; elsif Childs_Object'Valid and then STN_2_Num( Childs_Object ) in 0 .. Imp_H.Scalar_To_Normalize'Pos(Imp_H.Scalar_To_Normalize'Last) then Report.Failed("Implicit initial value for child object is a " & "value of the type"); end if; if Imp_H.Default_For_Scalar_To_Normalize_Is_In_Range then if Hidden_Object /= Imp_H.Default_For_Scalar_To_Normalize then Report.Failed("Implicit initial value for protected package object " & "is not the predicted value"); end if; elsif Hidden_Object'Valid and then STN_2_Num( Hidden_Object ) in 0 .. Imp_H.Scalar_To_Normalize'Pos(Imp_H.Scalar_To_Normalize'Last) then Report.Failed("Implicit initial value for protected component " & "is a value of the type"); end if; if Imp_H.Default_For_Small_Number_Is_In_Range then if Hidden_Number /= Imp_H.Default_For_Small_Number then Report.Failed("Implicit initial value for protected number " & "is not the predicted value"); end if; elsif Hidden_Number'Valid and then Hidden_Number in 0 .. Imp_H.Small_Number(Report.Ident_Int(Small_Last)) then Report.Failed("Implicit initial value for protected number " & "is a value of the type"); end if; end Check_Embedded_Values; end Thingy; end CXH1001_0.CXH1001_1; ------------------------------------------------------------------- CXH1001 with Impdef.Annex_H; with Report; with CXH1001_0.CXH1001_1; procedure CXH1001 is package Imp_H renames Impdef.Annex_H; use type CXH1001_0.Num; My_Object : Imp_H.Scalar_To_Normalize; -- not initialized Value : CXH1001_0.Num := CXH1001_0.STN_2_Num ( My_Object ); -- My_Object is not initialized Parameter_Value : Imp_H.Scalar_To_Normalize := Imp_H.Scalar_To_Normalize'Last; type Structure is record -- not initialized Std_Int : Integer; Scalar : Imp_H.Scalar_To_Normalize; Num : CXH1001_0.Num; end record; S : Structure; -- not initialized procedure Bad_Code( Unassigned : out Imp_H.Scalar_To_Normalize ) is -- returns uninitialized OUT parameter begin if Report.Ident_Int( 0 ) = 1 then Report.Failed( "Nothing is something" ); Unassigned := Imp_H.Scalar_To_Normalize'First; end if; end Bad_Code; procedure Check( V : CXH1001_0.Num; Message : String ) is begin if Imp_H.Default_For_Scalar_To_Normalize_Is_In_Range then if V /= Imp_H.Scalar_To_Normalize'Pos( Imp_H.Default_For_Scalar_To_Normalize) then Report.Failed(Message & ": Implicit initial value for object " & "is not the predicted value"); end if; elsif V'Valid and then V in 0 .. Imp_H.Scalar_To_Normalize'Pos(Imp_H.Scalar_To_Normalize'Last) then Report.Failed(Message & ": Implicit initial value for object " & "is a value of the type"); end if; end Check; begin -- Main test procedure. Report.Test ("CXH1001", "Check that the configuration pragma " & "Normalize_Scalars causes uninitialized scalar " & "objects to be set to a predictable value. " & "Check that multiple compilation units are " & "affected. Check for uninitialized scalar " & "objects that are subcomponents of composite " & "objects, unassigned out parameters, have been " & "allocated without an initial value, and are " & "stand alone." ); CXH1001_0.Package_Check; if My_Object'Valid then Value := CXH1001_0.STN_2_Num ( My_Object ); -- My_Object not initialized end if; -- otherwise, we just leave Value uninitialized Check( Value, "main procedure variable" ); Bad_Code( Parameter_Value ); if Parameter_Value'Valid then Check( CXH1001_0.STN_2_Num ( Parameter_Value ), "Out parameter return" ); end if; if S.Scalar'Valid then Check( CXH1001_0.STN_2_Num ( S.Scalar ), "Record component" ); end if; CXH1001_0.CXH1001_1.Thingy.Check_Embedded_Values; Report.Result; end CXH1001;