-- C730A01.A
|
-- C730A01.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- 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
|
-- 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 in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- 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
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- Check that a tagged type declared in a package specification
|
-- Check that a tagged type declared in a package specification
|
-- may be passed as a generic formal (tagged) private type to a generic
|
-- may be passed as a generic formal (tagged) private type to a generic
|
-- package declaration. Check that the formal type may be extended with
|
-- package declaration. Check that the formal type may be extended with
|
-- a private extension in the generic package.
|
-- a private extension in the generic package.
|
--
|
--
|
-- Check that, in the instance, the private extension inherits the
|
-- Check that, in the instance, the private extension inherits the
|
-- user-defined primitive subprograms of the tagged actual.
|
-- user-defined primitive subprograms of the tagged actual.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- Declare a tagged type and an associated primitive subprogram in a
|
-- Declare a tagged type and an associated primitive subprogram in a
|
-- package specification (foundation code). Declare a generic package
|
-- package specification (foundation code). Declare a generic package
|
-- which takes a tagged type as a formal parameter, and then extends
|
-- which takes a tagged type as a formal parameter, and then extends
|
-- it with a private extension (foundation code).
|
-- it with a private extension (foundation code).
|
--
|
--
|
-- Instantiate the generic package with the tagged type from the first
|
-- Instantiate the generic package with the tagged type from the first
|
-- package (the "generic" extension should now have inherited
|
-- package (the "generic" extension should now have inherited
|
-- the primitive subprogram of the tagged type from the first
|
-- the primitive subprogram of the tagged type from the first
|
-- package).
|
-- package).
|
--
|
--
|
-- In the main program, call the primitive subprogram inherited by the
|
-- In the main program, call the primitive subprogram inherited by the
|
-- "generic" extension, and verify the correctness of the components.
|
-- "generic" extension, and verify the correctness of the components.
|
--
|
--
|
-- TEST FILES:
|
-- TEST FILES:
|
-- The following files comprise this test:
|
-- The following files comprise this test:
|
--
|
--
|
-- F730A000.A
|
-- F730A000.A
|
-- F730A001.A
|
-- F730A001.A
|
-- => C730A01.A
|
-- => C730A01.A
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 06 Dec 94 SAIC ACVC 2.0
|
--
|
--
|
--!
|
--!
|
|
|
|
|
with F730A001; -- Book definitions.
|
with F730A001; -- Book definitions.
|
package C730A01_0 is -- Raw data to be used in creating book elements.
|
package C730A01_0 is -- Raw data to be used in creating book elements.
|
|
|
|
|
Book_Count : constant := 3;
|
Book_Count : constant := 3;
|
|
|
subtype Number_Of_Books is Integer range 1 .. Book_Count;
|
subtype Number_Of_Books is Integer range 1 .. Book_Count;
|
|
|
type Data_List is array (Number_Of_Books) of F730A001.Text_Ptr;
|
type Data_List is array (Number_Of_Books) of F730A001.Text_Ptr;
|
|
|
Title_List : Data_List := (new String'("Wuthering Heights"),
|
Title_List : Data_List := (new String'("Wuthering Heights"),
|
new String'("Heart of Darkness"),
|
new String'("Heart of Darkness"),
|
new String'("Ulysses"));
|
new String'("Ulysses"));
|
|
|
Author_List : Data_List := (new String'("Bronte, Emily"),
|
Author_List : Data_List := (new String'("Bronte, Emily"),
|
new String'("Conrad, Joseph"),
|
new String'("Conrad, Joseph"),
|
new String'("Joyce, James"));
|
new String'("Joyce, James"));
|
|
|
end C730A01_0;
|
end C730A01_0;
|
|
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
|
|
|
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
|
|
-- Library-level instantiation. Actual parameter is tagged record.
|
-- Library-level instantiation. Actual parameter is tagged record.
|
|
|
with F730A001; -- Book definitions.
|
with F730A001; -- Book definitions.
|
with F730A000; -- Singly-linked list abstraction.
|
with F730A000; -- Singly-linked list abstraction.
|
package C730A01_1 is new F730A000 (Parent_Type => F730A001.Book_Type);
|
package C730A01_1 is new F730A000 (Parent_Type => F730A001.Book_Type);
|
|
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
|
|
with Report;
|
with Report;
|
|
|
with F730A001; -- Book definitions.
|
with F730A001; -- Book definitions.
|
with C730A01_0; -- Raw book data.
|
with C730A01_0; -- Raw book data.
|
with C730A01_1; -- Instance.
|
with C730A01_1; -- Instance.
|
|
|
use F730A001; -- Primitive operations of Book_Type directly visible.
|
use F730A001; -- Primitive operations of Book_Type directly visible.
|
use C730A01_1; -- Operations inherited by Node_Type directly visible.
|
use C730A01_1; -- Operations inherited by Node_Type directly visible.
|
|
|
procedure C730A01 is
|
procedure C730A01 is
|
|
|
|
|
List_Of_Books : Priv_Node_Ptr := null; -- Head of linked list of books.
|
List_Of_Books : Priv_Node_Ptr := null; -- Head of linked list of books.
|
|
|
|
|
--========================================================--
|
--========================================================--
|
|
|
|
|
procedure Create_List (Title, Author : in C730A01_0.Data_List;
|
procedure Create_List (Title, Author : in C730A01_0.Data_List;
|
Head : in out Priv_Node_Ptr) is
|
Head : in out Priv_Node_Ptr) is
|
|
|
Book : Priv_Node_Type; -- Object of extended type.
|
Book : Priv_Node_Type; -- Object of extended type.
|
Book_Ptr : Priv_Node_Ptr;
|
Book_Ptr : Priv_Node_Ptr;
|
|
|
begin
|
begin
|
for I in C730A01_0.Number_Of_Books loop
|
for I in C730A01_0.Number_Of_Books loop
|
Create_Book (Title (I), Author (I), Book); -- Call inherited
|
Create_Book (Title (I), Author (I), Book); -- Call inherited
|
-- operation.
|
-- operation.
|
Book_Ptr := new Priv_Node_Type'(Book);
|
Book_Ptr := new Priv_Node_Type'(Book);
|
Add (Book_Ptr, Head);
|
Add (Book_Ptr, Head);
|
end loop;
|
end loop;
|
end Create_List;
|
end Create_List;
|
|
|
|
|
--========================================================--
|
--========================================================--
|
|
|
|
|
function Bad_List_Contents return Boolean is
|
function Bad_List_Contents return Boolean is
|
Book1_Ptr : Priv_Node_Ptr;
|
Book1_Ptr : Priv_Node_Ptr;
|
Book2_Ptr : Priv_Node_Ptr;
|
Book2_Ptr : Priv_Node_Ptr;
|
Book3_Ptr : Priv_Node_Ptr;
|
Book3_Ptr : Priv_Node_Ptr;
|
begin
|
begin
|
Remove (List_Of_Books, Book1_Ptr);
|
Remove (List_Of_Books, Book1_Ptr);
|
Remove (List_Of_Books, Book2_Ptr);
|
Remove (List_Of_Books, Book2_Ptr);
|
Remove (List_Of_Books, Book3_Ptr);
|
Remove (List_Of_Books, Book3_Ptr);
|
return (Book1_Ptr.Title.all /= "Ulysses" or -- Inherited
|
return (Book1_Ptr.Title.all /= "Ulysses" or -- Inherited
|
Book1_Ptr.Author.all /= "Joyce, James" or -- components
|
Book1_Ptr.Author.all /= "Joyce, James" or -- components
|
Book2_Ptr.Title.all /= "Heart of Darkness" or -- should still
|
Book2_Ptr.Title.all /= "Heart of Darkness" or -- should still
|
Book2_Ptr.Author.all /= "Conrad, Joseph" or -- be visible in
|
Book2_Ptr.Author.all /= "Conrad, Joseph" or -- be visible in
|
Book3_Ptr.Title.all /= "Wuthering Heights" or -- private
|
Book3_Ptr.Title.all /= "Wuthering Heights" or -- private
|
Book3_Ptr.Author.all /= "Bronte, Emily"); -- extension.
|
Book3_Ptr.Author.all /= "Bronte, Emily"); -- extension.
|
|
|
end Bad_List_Contents;
|
end Bad_List_Contents;
|
|
|
|
|
--========================================================--
|
--========================================================--
|
|
|
|
|
begin -- Main program.
|
begin -- Main program.
|
|
|
Report.Test ("C730A01", "Inheritance of primitive operations: private " &
|
Report.Test ("C730A01", "Inheritance of primitive operations: private " &
|
"extension of formal tagged private type; actual is " &
|
"extension of formal tagged private type; actual is " &
|
"an ultimate ancestor type");
|
"an ultimate ancestor type");
|
|
|
-- Create linked list using inherited operation:
|
-- Create linked list using inherited operation:
|
Create_List (C730A01_0.Title_List, C730A01_0.Author_List, List_Of_Books);
|
Create_List (C730A01_0.Title_List, C730A01_0.Author_List, List_Of_Books);
|
|
|
-- Verify results:
|
-- Verify results:
|
if Bad_List_Contents then
|
if Bad_List_Contents then
|
Report.Failed ("Wrong values after call to inherited operation");
|
Report.Failed ("Wrong values after call to inherited operation");
|
end if;
|
end if;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end C730A01;
|
end C730A01;
|
|
|
