URL
https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk
Subversion Repositories openrisc_2011-10-31
[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c340001.a] - Rev 294
Go to most recent revision | Compare with Previous | Blame | View Log
-- C340001.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 equality operators are inherited by a
-- derived type except when the derived type is a nonlimited record
-- extension. In the latter case, ensure that the primitive
-- equality operation of the record extension compares any extended
-- components according to the predefined equality operators of the
-- component types. Also check that the parent portion of the extended
-- type is compared using the user-defined equality operation of the
-- parent type.
--
-- TEST DESCRIPTION:
-- Declares a nonlimited tagged record and a limited tagged record
-- type, each in a separate package. A user-defined "=" operation is
-- defined for each type. Each type is extended with one new record
-- component added.
--
-- Objects are declared for each parent and extended types and are
-- assigned values. For the limited type, modifier operations defined
-- in the package are used to assign values.
--
-- To verify the use of the user-defined "=", values are assigned so
-- that predefined equality will return the opposite result if called.
-- Similarly, values are assigned to the extended type objects so that
-- one comparison will verify that the inherited components from the
-- parent are compared using the user-defined equality operation.
--
-- A second comparison sets the values of the inherited components to
-- be the same so that equality based on the extended component may be
-- verified. For the nonlimited type, the test for equality should
-- fail, as the "=" defined for this type should include testing
-- equality of the extended component. For the limited type, "=" of the
-- parent should be inherited as-is, so the test for equality should
-- succeed even though the records differ in the extended component.
--
-- A third package declares a discriminated tagged record. Equality
-- is user-defined and ignores the discriminant value. A type
-- extension is declared which also contains a discriminant. Since
-- an inherited discriminant may not be referenced other than in a
-- "new" discriminant, the type extension is also discriminated. The
-- discriminant is used as the constraint for the parent type.
--
-- A variant part is declared in the type extension based on the new
-- discriminant. Comparisons are made to confirm that the user-defined
-- equality operator is used to compare values of the type extension.
-- Two record objects are given values so that user-defined equality
-- for the parent portion of the record succeeds, but the variant
-- parts in the type extended object differ. These objects are checked
-- to ensure that they are not equal.
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
-- 19 Dec 94 SAIC Removed RM references from objective text.
--
--!
with Ada.Calendar;
package C340001_0 is
type DB_Record is tagged record
Key : Natural range 1 .. 9999;
Data : String (1..10);
end record;
function "=" (L, R : in DB_Record) return Boolean;
type Dated_Record is new DB_Record with record
Retrieval_Time : Ada.Calendar.Time;
end record;
end C340001_0;
package body C340001_0 is
function "=" (L, R : in DB_Record) return Boolean is
-- Key is ignored in determining equality of records
begin
return L.Data = R.Data;
end "=";
end C340001_0;
package C340001_1 is
type List_Contents is array (1..10) of Integer;
type List is tagged limited record
Length : Natural range 0..10 := 0;
Contents : List_Contents := (others => 0);
end record;
procedure Add_To (L : in out List; New_Value : in Integer);
procedure Remove_From (L : in out List);
function "=" (L, R : in List) return Boolean;
subtype Revision_Mark is Character range 'A' .. 'Z';
type Revisable_List is new List with record
Revision : Revision_Mark := 'A';
end record;
procedure Revise (L : in out Revisable_List);
end C340001_1;
package body C340001_1 is
-- Note: This is not a complete abstraction of a list. Exceptions
-- are not defined and boundary checks are not made.
procedure Add_To (L : in out List; New_Value : in Integer) is
begin
L.Length := L.Length + 1;
L.Contents (L.Length) := New_Value;
end Add_To;
procedure Remove_From (L : in out List) is
-- The list length is decremented. "Old" values are left in the
-- array. They are overwritten when a new value is added.
begin
L.Length := L.Length - 1;
end Remove_From;
function "=" (L, R : in List) return Boolean is
-- Two lists are equal if they are the same length and
-- the component values within that length are the same.
-- Values stored past the end of the list are ignored.
begin
return L.Length = R.Length
and then L.Contents (1..L.Length) = R.Contents (1..R.Length);
end "=";
procedure Revise (L : in out Revisable_List) is
begin
L.Revision := Character'Succ (L.Revision);
end Revise;
end C340001_1;
package C340001_2 is
type Media is (Paper, Electronic);
type Transaction (Medium : Media) is tagged record
ID : Natural range 1000 .. 9999;
end record;
function "=" (L, R : in Transaction) return Boolean;
type Authorization (Kind : Media) is new Transaction (Medium => Kind)
with record
case Kind is
when Paper =>
Signature_On_File : Boolean;
when Electronic =>
Paper_Backup : Boolean; -- to retain opposing value
end case;
end record;
end C340001_2;
package body C340001_2 is
function "=" (L, R : in Transaction) return Boolean is
-- There may be electronic and paper copies of the same transaction.
-- The ID uniquely identifies a transaction. The medium (stored in
-- the discriminant) is ignored.
begin
return L.ID = R.ID;
end "=";
end C340001_2;
with C340001_0; -- nonlimited tagged record declarations
with C340001_1; -- limited tagged record declarations
with C340001_2; -- tagged variant declarations
with Ada.Calendar;
with Report;
procedure C340001 is
DB_Rec1 : C340001_0.DB_Record := (Key => 1,
Data => "aaaaaaaaaa");
DB_Rec2 : C340001_0.DB_Record := (Key => 55,
Data => "aaaaaaaaaa");
-- DB_Rec1 = DB_Rec2 using user-defined equality
-- DB_Rec1 /= DB_Rec2 using predefined equality
Some_Time : Ada.Calendar.Time :=
Ada.Calendar.Time_Of (Month => 9, Day => 16, Year => 1993);
Another_Time : Ada.Calendar.Time :=
Ada.Calendar.Time_Of (Month => 9, Day => 19, Year => 1993);
Dated_Rec1 : C340001_0.Dated_Record := (Key => 2,
Data => "aaaaaaaaaa",
Retrieval_Time => Some_Time);
Dated_Rec2 : C340001_0.Dated_Record := (Key => 77,
Data => "aaaaaaaaaa",
Retrieval_Time => Some_Time);
Dated_Rec3 : C340001_0.Dated_Record := (Key => 77,
Data => "aaaaaaaaaa",
Retrieval_Time => Another_Time);
-- Dated_Rec1 = Dated_Rec2 if DB_Record."=" used for parent portion
-- Dated_Rec2 /= Dated_Rec3 if extended component is compared
-- using Ada.Calendar.Time."="
List1 : C340001_1.List;
List2 : C340001_1.List;
RList1 : C340001_1.Revisable_List;
RList2 : C340001_1.Revisable_List;
RList3 : C340001_1.Revisable_List;
Current : C340001_2.Transaction (C340001_2.Paper) :=
(C340001_2.Paper, 2001);
Last : C340001_2.Transaction (C340001_2.Electronic) :=
(C340001_2.Electronic, 2001);
-- Current = Last using user-defined equality
-- Current /= Last using predefined equality
Approval1 : C340001_2.Authorization (C340001_2.Paper)
:= (Kind => C340001_2.Paper,
ID => 1040,
Signature_On_File => True);
Approval2 : C340001_2.Authorization (C340001_2.Paper)
:= (Kind => C340001_2.Paper,
ID => 2167,
Signature_On_File => False);
Approval3 : C340001_2.Authorization (C340001_2.Electronic)
:= (Kind => C340001_2.Electronic,
ID => 2167,
Paper_Backup => False);
-- Approval1 /= Approval2 if user-defined equality extended with
-- component equality.
-- Approval2 /= Approval3 if differing variant parts checked
-- Direct visibility to operator symbols
use type C340001_0.DB_Record;
use type C340001_0.Dated_Record;
use type C340001_1.List;
use type C340001_1.Revisable_List;
use type C340001_2.Transaction;
use type C340001_2.Authorization;
begin
Report.Test ("C340001", "Inheritance of user-defined ""=""");
-- Approval1 /= Approval2 if user-defined equality extended with
-- component equality.
-- Approval2 /= Approval3 if differing variant parts checked
---------------------------------------------------------------------
-- Check that "=" and "/=" for the parent type call the user-defined
-- operation
---------------------------------------------------------------------
if not (DB_Rec1 = DB_Rec2) then
Report.Failed ("Nonlimited tagged record: " &
"User-defined equality did not override predefined " &
"equality");
end if;
if DB_Rec1 /= DB_Rec2 then
Report.Failed ("Nonlimited tagged record: " &
"User-defined equality did not override predefined " &
"inequality as well");
end if;
---------------------------------------------------------------------
-- Check that "=" and "/=" for the type extension use the user-defined
-- equality operations from the parent to compare the inherited
-- components
---------------------------------------------------------------------
if not (Dated_Rec1 = Dated_Rec2) then
Report.Failed ("Nonlimited tagged record: " &
"User-defined equality was not used to compare " &
"components inherited from parent");
end if;
if Dated_Rec1 /= Dated_Rec2 then
Report.Failed ("Nonlimited tagged record: " &
"User-defined inequality was not used to compare " &
"components inherited from parent");
end if;
---------------------------------------------------------------------
-- Check that equality and inequality for the type extension incorporate
-- the predefined equality operators for the extended component type
---------------------------------------------------------------------
if Dated_Rec2 = Dated_Rec3 then
Report.Failed ("Nonlimited tagged record: " &
"Record equality was not extended with component " &
"equality");
end if;
if not (Dated_Rec2 /= Dated_Rec3) then
Report.Failed ("Nonlimited tagged record: " &
"Record inequality was not extended with component " &
"equality");
end if;
---------------------------------------------------------------------
C340001_1.Add_To (List1, 1);
C340001_1.Add_To (List1, 2);
C340001_1.Add_To (List1, 3);
C340001_1.Remove_From (List1);
C340001_1.Add_To (List2, 1);
C340001_1.Add_To (List2, 2);
-- List1 contents are (2, (1, 2, 3, 0, 0, 0, 0, 0, 0, 0))
-- List2 contents are (2, (1, 2, 0, 0, 0, 0, 0, 0, 0, 0))
-- List1 = List2 using user-defined equality
-- List1 /= List2 using predefined equality
---------------------------------------------------------------------
-- Check that "=" and "/=" for the parent type call the user-defined
-- operation
---------------------------------------------------------------------
if not (List1 = List2) then
Report.Failed ("Limited tagged record : " &
"User-defined equality incorrectly implemented " );
end if;
if List1 /= List2 then
Report.Failed ("Limited tagged record : " &
"User-defined equality incorrectly implemented " );
end if;
---------------------------------------------------------------------
-- RList1 and RList2 are made equal but "different" by adding
-- a nonzero value to RList1 then removing it. Removal updates
-- the list Length only, not its contents. The two lists will be
-- equal according to the defined list abstraction, but the records
-- will contain differing component values.
C340001_1.Add_To (RList1, 1);
C340001_1.Add_To (RList1, 2);
C340001_1.Add_To (RList1, 3);
C340001_1.Remove_From (RList1);
C340001_1.Add_To (RList2, 1);
C340001_1.Add_To (RList2, 2);
C340001_1.Add_To (RList3, 1);
C340001_1.Add_To (RList3, 2);
C340001_1.Revise (RList3);
-- RList1 contents are (2, (1, 2, 3, 0, 0, 0, 0, 0, 0, 0), 'A')
-- RList2 contents are (2, (1, 2, 0, 0, 0, 0, 0, 0, 0, 0), 'A')
-- RList3 contents are (2, (1, 2, 0, 0, 0, 0, 0, 0, 0, 0), 'B')
-- RList1 = RList2 if List."=" inherited
-- RList2 /= RList3 if List."=" inherited and extended with Character "="
---------------------------------------------------------------------
-- Check that "=" and "/=" are the user-defined operations inherited
-- from the parent type.
---------------------------------------------------------------------
if not (RList1 = RList2) then
Report.Failed ("Limited tagged record : " &
"User-defined equality was not inherited");
end if;
if RList1 /= RList2 then
Report.Failed ("Limited tagged record : " &
"User-defined inequality was not inherited");
end if;
---------------------------------------------------------------------
-- Check that "=" and "/=" for the type extension are NOT extended
-- with the predefined equality operators for the extended component.
-- A limited type extension should inherit the parent equality operation
-- as is.
---------------------------------------------------------------------
if not (RList2 = RList3) then
Report.Failed ("Limited tagged record : " &
"Inherited equality operation was extended with " &
"component equality");
end if;
if RList2 /= RList3 then
Report.Failed ("Limited tagged record : " &
"Inherited inequality operation was extended with " &
"component equality");
end if;
---------------------------------------------------------------------
-- Check that "=" and "/=" for the parent type call the user-defined
-- operation
---------------------------------------------------------------------
if not (Current = Last) then
Report.Failed ("Variant record : " &
"User-defined equality did not override predefined " &
"equality");
end if;
if Current /= Last then
Report.Failed ("Variant record : " &
"User-defined inequality did not override predefined " &
"inequality");
end if;
---------------------------------------------------------------------
-- Check that user-defined equality was incorporated and extended
-- with equality of extended components.
---------------------------------------------------------------------
if not (Approval1 /= Approval2) then
Report.Failed ("Variant record : " &
"Inequality was not extended with component " &
"inequality");
end if;
if Approval1 = Approval2 then
Report.Failed ("Variant record : " &
"Equality was not extended with component " &
"equality");
end if;
---------------------------------------------------------------------
-- Check that equality and inequality for the type extension
-- succeed despite the presence of differing variant parts.
---------------------------------------------------------------------
if Approval2 = Approval3 then
Report.Failed ("Variant record : " &
"Equality succeeded even though variant parts " &
"in type extension differ");
end if;
if not (Approval2 /= Approval3) then
Report.Failed ("Variant record : " &
"Inequality failed even though variant parts " &
"in type extension differ");
end if;
---------------------------------------------------------------------
Report.Result;
---------------------------------------------------------------------
end C340001;
Go to most recent revision | Compare with Previous | Blame | View Log