diff options
author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
---|---|---|
committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/ada/acats/tests/cxh/cxh1001.a | |
download | cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2 cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz |
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.
downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.
if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxh/cxh1001.a')
-rw-r--r-- | gcc/testsuite/ada/acats/tests/cxh/cxh1001.a | 349 |
1 files changed, 349 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxh/cxh1001.a b/gcc/testsuite/ada/acats/tests/cxh/cxh1001.a new file mode 100644 index 000000000..12379a1a5 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxh/cxh1001.a @@ -0,0 +1,349 @@ +-- 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; |