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/cxa/cxacb02.a | |
download | cbb-gcc-4.6.4-upstream.tar.bz2 cbb-gcc-4.6.4-upstream.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/cxa/cxacb02.a')
-rw-r--r-- | gcc/testsuite/ada/acats/tests/cxa/cxacb02.a | 421 |
1 files changed, 421 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxacb02.a b/gcc/testsuite/ada/acats/tests/cxa/cxacb02.a new file mode 100644 index 000000000..a0ade9ebe --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxa/cxacb02.a @@ -0,0 +1,421 @@ +-- CXACB02.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 that user defined subprograms can override the default +-- attributes 'Input and 'Output using attribute definition clauses, +-- when used with objects of discriminated record and multi-dimensional +-- array types. +-- +-- TEST DESCRIPTION: +-- This test demonstrates that the default implementations of the +-- 'Input and 'Output attributes can be overridden by user specified +-- subprograms in conjunction with attribute definition clauses. +-- These attributes have been overridden below, and in the user defined +-- substitutes, values are added or subtracted to global variables. +-- Following the completion of the writing/reading test, the global +-- variables are evaluated to ensure that the user defined subprograms +-- were used in overriding the type-related default attributes. +-- +-- APPLICABILITY CRITERIA: +-- Applicable to all implementations that support external +-- Stream_IO files. +-- +-- +-- CHANGE HISTORY: +-- 06 Dec 94 SAIC ACVC 2.0 +-- 14 Nov 95 SAIC Corrected test errors for ACVC 2.0.1. +-- +--! + +with Report; +with Ada.Streams.Stream_IO; + +procedure CXACB02 is +begin + + Report.Test ("CXACB02", "Check that user defined subprograms can " & + "override the default attributes 'Input and " & + "'Output using attribute definition clauses"); + + Test_for_Stream_IO_Support: + declare + + Util_File : Ada.Streams.Stream_IO.File_Type; + Util_Stream : Ada.Streams.Stream_IO.Stream_Access; + Utility_Filename : constant String := Report.Legal_File_Name; + + begin + + -- If an implementation does not support Stream_IO in a particular + -- environment, the exception Use_Error or Name_Error will be raised on + -- calls to various Stream_IO operations. This block statement + -- encloses a call to Create, which should produce an exception in a + -- non-supportive environment. These exceptions will be handled to + -- produce a Not_Applicable result. + + Ada.Streams.Stream_IO.Create (Util_File, + Ada.Streams.Stream_IO.Out_File, + Utility_Filename); + + Operational_Test_Block: + declare + + type Customer_Type is (Residence, Apartment, Commercial); + type Electric_Usage_Type is range 0..100000; + type Months_In_Service_Type is range 1..12; + type Quarterly_Period_Type is (Spring, Summer, Autumn, Winter); + subtype Month_In_Quarter_Type is Positive range 1..3; + type Service_History_Type is + array (Quarterly_Period_Type range <>, + Month_In_Quarter_Type range <>) of Electric_Usage_Type; + + type Service_Type (Customer : Customer_Type) is + record + Name : String (1..21); + Account_ID : Natural range 0..100; + case Customer is + when Residence | Apartment => + Low_Income_Credit : Boolean := False; + when Commercial => + Baseline_Allowance : Natural range 0..1000; + Quantity_Discount : Boolean := False; + end case; + end record; + + + -- Mode conformant, user defined subprograms that will override + -- the type-related attributes. + -- In this test, the user defines these subprograms to add/subtract + -- specific values from global variables. + + function Service_Input + (Stream : access Ada.Streams.Root_Stream_Type'Class) + return Service_Type; + + procedure Service_Output + (Stream : access Ada.Streams.Root_Stream_Type'Class; + Item : Service_Type); + + function History_Input + (Stream : access Ada.Streams.Root_Stream_Type'Class) + return Service_History_Type; + + procedure History_Output + (Stream : access Ada.Streams.Root_Stream_Type'Class; + Item : Service_History_Type); + + + -- Attribute definition clauses. + + for Service_Type'Input use Service_Input; + for Service_Type'Output use Service_Output; + + for Service_History_Type'Input use History_Input; + for Service_History_Type'Output use History_Output; + + + -- Object Declarations + + Customer1 : Service_Type (Residence) := + (Residence, "1221 Morningstar Lane", 44, False); + Customer2 : Service_Type (Apartment) := + (Customer => Apartment, + Account_ID => 67, + Name => "15 South Front St. #8", + Low_Income_Credit => True); + Customer3 : Service_Type (Commercial) := + (Commercial, + "12442 Central Avenue ", + 100, + Baseline_Allowance => 938, + Quantity_Discount => True); + + C1_Service_History : + Service_History_Type (Quarterly_Period_Type, + Month_In_Quarter_Type) := + (Spring => (1 => 35, 2 => 39, 3 => 32), + Summer => (1 => 34, 2 => 33, 3 => 39), + Autumn => (1 => 45, 2 => 40, 3 => 38), + Winter => (1 => 53, 2 => 0, 3 => 0)); + + C2_Service_History : + Service_History_Type (Quarterly_Period_Type range Spring..Summer, + Month_In_Quarter_Type) := + (Spring => (23, 22, 0), Summer => (0, 0, 0)); + + C3_Service_History : + Service_History_Type (Quarterly_Period_Type, + Month_In_Quarter_Type) := + (others => (others => 200)); + + + TC_Input_Total : Integer := 0; + TC_Output_Total : Integer := 0; + + + -- Subprogram bodies. + -- These subprograms are designed to override the default attributes + -- 'Input and 'Output for the specified types. Each adds/subtracts + -- a quantity to/from a program control variable, indicating its + -- activity. Each user defined "Input" function uses the 'Read + -- attribute for the type to accomplish the operation. Likewise, + -- each user defined "Output" subprogram uses the 'Write attribute + -- for the type. + + function Service_Input + ( Stream : access Ada.Streams.Root_Stream_Type'Class ) + return Service_Type is + Customer : Customer_Type; + begin + TC_Input_Total := TC_Input_Total + 1; + + -- Extract the discriminant value from the stream. + -- This discriminant would not otherwise be extracted from the + -- stream when the Service_Type'Read attribute is used below. + Customer_Type'Read (Stream, Customer); + + declare + -- Declare a constant of Service_Type, using the value just + -- read from the stream as the discriminant value of the + -- object. + Service : Service_Type(Customer); + begin + Service_Type'Read (Stream, Service); + return Service; + end; + end Service_Input; + + + procedure Service_Output + ( Stream : access Ada.Streams.Root_Stream_Type'Class; + Item : Service_Type ) is + begin + TC_Output_Total := TC_Output_Total + 2; + -- Write the discriminant value to the stream. + -- The attribute 'Write (for the record type) will not write the + -- discriminant of the record object to the stream. Therefore, it + -- must be explicitly written using the 'Write attribute of the + -- discriminant type. + Customer_Type'Write (Stream, Item.Customer); + -- Write the record component values (but not the discriminant) to + -- the stream. + Service_Type'Write (Stream, Item); + end Service_Output; + + + function History_Input + ( Stream : access Ada.Streams.Root_Stream_Type'Class ) + return Service_History_Type is + Quarter_Bound_Low : Quarterly_Period_Type; + Quarter_Bound_High : Quarterly_Period_Type; + Month_Bound_Low : Month_In_Quarter_Type; + Month_Bound_High : Month_In_Quarter_Type; + begin + TC_Input_Total := TC_Input_Total + 3; + + -- Read the value of the array bounds from the stream. + -- Use these bounds in the creation of an array object that will + -- be used to store data from the stream. + -- The array bound values would not otherwise be read from the + -- stream by use of the Service_History_Type'Read attribute. + Quarterly_Period_Type'Read (Stream, Quarter_Bound_Low); + Quarterly_Period_Type'Read (Stream, Quarter_Bound_High); + Month_In_Quarter_Type'Read (Stream, Month_Bound_Low); + Month_In_Quarter_Type'Read (Stream, Month_Bound_High); + + declare + Service_History_Array : + Service_History_Type + (Quarterly_Period_Type range + Quarter_Bound_Low..Quarter_Bound_High, + Month_In_Quarter_Type range + Month_Bound_Low .. Month_Bound_High); + begin + Service_History_Type'Read (Stream, Service_History_Array); + return Service_History_Array; + end; + end History_Input; + + + procedure History_Output + ( Stream : access Ada.Streams.Root_Stream_Type'Class; + Item : Service_History_Type ) is + begin + TC_Output_Total := TC_Output_Total + 7; + -- Write the upper/lower bounds of the array object dimensions to + -- the stream. + Quarterly_Period_Type'Write (Stream, Item'First(1)); + Quarterly_Period_Type'Write (Stream, Item'Last(1)); + Month_In_Quarter_Type'Write (Stream, Item'First(2)); + Month_In_Quarter_Type'Write (Stream, Item'Last(2)); + -- Write the array values to the stream in canonical order (last + -- dimension varying fastest). + Service_History_Type'Write (Stream, Item); + end History_Output; + + + + begin + + Util_Stream := Ada.Streams.Stream_IO.Stream (Util_File); + + -- Write data to the stream. A customer service record is followed + -- by a service history array. + + Service_Type'Output (Util_Stream, Customer1); + Service_History_Type'Output (Util_Stream, C1_Service_History); + + Service_Type'Output (Util_Stream, Customer2); + Service_History_Type'Output (Util_Stream, C2_Service_History); + + Service_Type'Output (Util_Stream, Customer3); + Service_History_Type'Output (Util_Stream, C3_Service_History); + + + -- Read data from the stream, and verify the use of the user specified + -- attributes. + + Verify_Data_Block: + declare + + TC_Residence : Service_Type (Residence); + TC_Apartment : Service_Type (Apartment); + TC_Commercial : Service_Type (Commercial); + + TC_History1 : Service_History_Type (Quarterly_Period_Type, + Month_In_Quarter_Type) := + (others => (others => Electric_Usage_Type'First)); + + TC_History2 : Service_History_Type (Quarterly_Period_Type + range Spring .. Summer, + Month_In_Quarter_Type) := + (others => (others => Electric_Usage_Type'First)); + + TC_History3 : Service_History_Type (Quarterly_Period_Type, + Month_In_Quarter_Type) := + (others => (others => Electric_Usage_Type'First)); + + begin + + -- Reset Stream file to mode In_File. + + Ada.Streams.Stream_IO.Reset (Util_File, + Ada.Streams.Stream_IO.In_File); + + -- Read data from the stream. + + TC_Residence := Service_Type'Input (Util_Stream); + TC_History1 := Service_History_Type'Input (Util_Stream); + + TC_Apartment := Service_Type'Input (Util_Stream); + TC_History2 := Service_History_Type'Input (Util_Stream); + + TC_Commercial := Service_Type'Input (Util_Stream); + TC_History3 := Service_History_Type'Input (Util_Stream); + + + -- Verify product data was correctly written to/read from stream, + -- including discriminants and array bounds. + + if (TC_Residence /= Customer1) or + (TC_Residence.Customer /= Customer1.Customer) or + (TC_History1'Last(1) /= C1_Service_History'Last(1)) or + (TC_History1'First(1) /= C1_Service_History'First(1)) or + (TC_History1'Last(2) /= C1_Service_History'Last(2)) or + (TC_History1'First(2) /= C1_Service_History'First(2)) + then + Report.Failed ("Incorrect data from stream - 1"); + end if; + + if (TC_Apartment /= Customer2) or + (TC_Apartment.Customer /= Customer2.Customer) or + (TC_History2 /= C2_Service_History) or + (TC_History2'Last(1) /= C2_Service_History'Last(1)) or + (TC_History2'First(1) /= C2_Service_History'First(1)) or + (TC_History2'Last(2) /= C2_Service_History'Last(2)) or + (TC_History2'First(2) /= C2_Service_History'First(2)) + then + Report.Failed ("Incorrect data from stream - 2"); + end if; + + if (TC_Commercial /= Customer3) or + (TC_Commercial.Customer /= Customer3.Customer) or + (TC_History3 /= C3_Service_History) or + (TC_History3'Last(1) /= C3_Service_History'Last(1)) or + (TC_History3'First(1) /= C3_Service_History'First(1)) or + (TC_History3'Last(2) /= C3_Service_History'Last(2)) or + (TC_History3'First(2) /= C3_Service_History'First(2)) + then + Report.Failed ("Incorrect data from stream - 3"); + end if; + + -- Verify that the user defined subprograms were used to override + -- the default 'Input and 'Output attributes. + -- There were three calls on each of the user defined attributes. + + if (TC_Input_Total /= 12 ) or (TC_Output_Total /= 27 ) then + Report.Failed ("Incorrect use of user defined attributes"); + end if; + + end Verify_Data_Block; + + exception + + when others => + Report.Failed ("Exception raised in Operational Test Block"); + + end Operational_Test_Block; + + if Ada.Streams.Stream_IO.Is_Open (Util_File) then + Ada.Streams.Stream_IO.Delete (Util_File); + else + Ada.Streams.Stream_IO.Open (Util_File, + Ada.Streams.Stream_IO.Out_File, + Utility_Filename); + Ada.Streams.Stream_IO.Delete (Util_File); + end if; + + + exception + + -- Since Use_Error or Name_Error can be raised if, for the specified + -- mode, the environment does not support Stream_IO operations, + -- the following handlers are included: + + when Ada.Streams.Stream_IO.Name_Error => + Report.Not_Applicable ("Name_Error raised on Stream IO Create"); + + when Ada.Streams.Stream_IO.Use_Error => + Report.Not_Applicable ("Use_Error raised on Stream IO Create"); + + when others => + Report.Failed ("Unexpected exception raised"); + + end Test_for_Stream_IO_Support; + + Report.Result; + +end CXACB02; |