| -- 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; |
