-- C730004.A
|
-- C730004.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 for a type declared in a package, descendants of the package
|
-- Check that for a type declared in a package, descendants of the package
|
-- use the full view of type. Specifically check that full view of the
|
-- use the full view of type. Specifically check that full view of the
|
-- limited type is visible only in private descendants (children) and in
|
-- limited type is visible only in private descendants (children) and in
|
-- the private parts and bodies of public descendants (children).
|
-- the private parts and bodies of public descendants (children).
|
-- Check that a limited type may be used as an out parameter outside
|
-- Check that a limited type may be used as an out parameter outside
|
-- the package that defines the type.
|
-- the package that defines the type.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- This test defines a parent package containing limited private type
|
-- This test defines a parent package containing limited private type
|
-- definitions. Children packages are defined (one public, one private)
|
-- definitions. Children packages are defined (one public, one private)
|
-- that use the nonlimited full view of the types defined in the private
|
-- that use the nonlimited full view of the types defined in the private
|
-- part of the parent specification.
|
-- part of the parent specification.
|
-- The main declares a procedure with an out parameter that was defined
|
-- The main declares a procedure with an out parameter that was defined
|
-- as limited in the specification of the parent package.
|
-- as limited in the specification of the parent package.
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 15 Sep 95 SAIC Initial prerelease version.
|
-- 15 Sep 95 SAIC Initial prerelease version.
|
-- 23 Apr 96 SAIC Added prefix for parameter in Call_Modify_File.
|
-- 23 Apr 96 SAIC Added prefix for parameter in Call_Modify_File.
|
-- 02 Nov 96 SAIC ACVC 2.1: Modified prologue and Test.Report.
|
-- 02 Nov 96 SAIC ACVC 2.1: Modified prologue and Test.Report.
|
--
|
--
|
--!
|
--!
|
|
|
package C730004_0 is
|
package C730004_0 is
|
|
|
-- Full views of File_Descriptor, File_Mode, File_Name, and File_Type are
|
-- Full views of File_Descriptor, File_Mode, File_Name, and File_Type are
|
-- are nonlimited.
|
-- are nonlimited.
|
|
|
type File_Descriptor is limited private;
|
type File_Descriptor is limited private;
|
|
|
type File_Mode is limited private;
|
type File_Mode is limited private;
|
|
|
Active_Mode : constant File_Mode;
|
Active_Mode : constant File_Mode;
|
|
|
type File_Name is limited private;
|
type File_Name is limited private;
|
|
|
type File_Type is limited private;
|
type File_Type is limited private;
|
|
|
function Next_Available_File return File_Descriptor;
|
function Next_Available_File return File_Descriptor;
|
|
|
private
|
private
|
|
|
type File_Descriptor is new Integer;
|
type File_Descriptor is new Integer;
|
|
|
Null_File : constant File_Descriptor := 0;
|
Null_File : constant File_Descriptor := 0;
|
First_File : constant File_Descriptor := 1;
|
First_File : constant File_Descriptor := 1;
|
|
|
type File_Mode is
|
type File_Mode is
|
(Read_Only, Write_Only, Read_Write, Archived, Corrupt, Lost);
|
(Read_Only, Write_Only, Read_Write, Archived, Corrupt, Lost);
|
|
|
Default_Mode : constant File_Mode := Read_Only;
|
Default_Mode : constant File_Mode := Read_Only;
|
Active_Mode : constant File_Mode := Read_Write;
|
Active_Mode : constant File_Mode := Read_Write;
|
|
|
type File_Name is array (1 .. 6) of Character;
|
type File_Name is array (1 .. 6) of Character;
|
|
|
Null_String : File_Name := " ";
|
Null_String : File_Name := " ";
|
String1 : File_Name := "ACVC ";
|
String1 : File_Name := "ACVC ";
|
String2 : File_Name := " 1995";
|
String2 : File_Name := " 1995";
|
|
|
type File_Type is
|
type File_Type is
|
record
|
record
|
Descriptor : File_Descriptor := Null_File;
|
Descriptor : File_Descriptor := Null_File;
|
Mode : File_Mode := Default_Mode;
|
Mode : File_Mode := Default_Mode;
|
Name : File_Name := Null_String;
|
Name : File_Name := Null_String;
|
end record;
|
end record;
|
|
|
end C730004_0;
|
end C730004_0;
|
|
|
--=================================================================--
|
--=================================================================--
|
|
|
package body C730004_0 is
|
package body C730004_0 is
|
|
|
File_Count : Integer := 0;
|
File_Count : Integer := 0;
|
|
|
function Next_Available_File return File_Descriptor is
|
function Next_Available_File return File_Descriptor is
|
begin
|
begin
|
File_Count := File_Count + 1;
|
File_Count := File_Count + 1;
|
return (File_Descriptor(File_Count)); -- Type conversion.
|
return (File_Descriptor(File_Count)); -- Type conversion.
|
end Next_Available_File;
|
end Next_Available_File;
|
|
|
end C730004_0;
|
end C730004_0;
|
|
|
--=================================================================--
|
--=================================================================--
|
|
|
private
|
private
|
package C730004_0.C730004_1 is -- private child
|
package C730004_0.C730004_1 is -- private child
|
|
|
-- Since full view of the nontagged File_Name is nonlimited in the parent
|
-- Since full view of the nontagged File_Name is nonlimited in the parent
|
-- package, it is not limited in the private child, so concatenation is
|
-- package, it is not limited in the private child, so concatenation is
|
-- available.
|
-- available.
|
|
|
System_File_Name : constant File_Name
|
System_File_Name : constant File_Name
|
:= String1(1..4) & String2(5..6);
|
:= String1(1..4) & String2(5..6);
|
|
|
-- Since full view of the nontagged File_Type is nonlimited in the parent
|
-- Since full view of the nontagged File_Type is nonlimited in the parent
|
-- package, it is not limited in the private child, so a default expression
|
-- package, it is not limited in the private child, so a default expression
|
-- is available.
|
-- is available.
|
|
|
function New_File_Validated (File : File_Type
|
function New_File_Validated (File : File_Type
|
:= (Descriptor => First_File,
|
:= (Descriptor => First_File,
|
Mode => Active_Mode,
|
Mode => Active_Mode,
|
Name => System_File_Name))
|
Name => System_File_Name))
|
return Boolean;
|
return Boolean;
|
|
|
-- Since full view of the nontagged File_Type is nonlimited in the parent
|
-- Since full view of the nontagged File_Type is nonlimited in the parent
|
-- package, it is not limited in the private child, so initialization
|
-- package, it is not limited in the private child, so initialization
|
-- expression in an object declaration is available.
|
-- expression in an object declaration is available.
|
|
|
System_File : File_Type
|
System_File : File_Type
|
:= (Null_File, Read_Only, System_File_Name);
|
:= (Null_File, Read_Only, System_File_Name);
|
|
|
|
|
end C730004_0.C730004_1;
|
end C730004_0.C730004_1;
|
|
|
--=================================================================--
|
--=================================================================--
|
|
|
package body C730004_0.C730004_1 is
|
package body C730004_0.C730004_1 is
|
|
|
function New_File_Validated (File : File_Type
|
function New_File_Validated (File : File_Type
|
:= (Descriptor => First_File,
|
:= (Descriptor => First_File,
|
Mode => Active_Mode,
|
Mode => Active_Mode,
|
Name => System_File_Name))
|
Name => System_File_Name))
|
return Boolean is
|
return Boolean is
|
Result : Boolean := False;
|
Result : Boolean := False;
|
begin
|
begin
|
if (File.Descriptor > System_File.Descriptor) and
|
if (File.Descriptor > System_File.Descriptor) and
|
(File.Mode in Read_Only .. Read_Write) and (File.Name = "ACVC95")
|
(File.Mode in Read_Only .. Read_Write) and (File.Name = "ACVC95")
|
then
|
then
|
Result := True;
|
Result := True;
|
end if;
|
end if;
|
|
|
return (Result);
|
return (Result);
|
|
|
end New_File_Validated;
|
end New_File_Validated;
|
|
|
end C730004_0.C730004_1;
|
end C730004_0.C730004_1;
|
|
|
--=================================================================--
|
--=================================================================--
|
|
|
package C730004_0.C730004_2 is -- public child
|
package C730004_0.C730004_2 is -- public child
|
|
|
-- File_Type is limited here.
|
-- File_Type is limited here.
|
|
|
procedure Create_File (File : out File_Type);
|
procedure Create_File (File : out File_Type);
|
|
|
procedure Modify_File (File : out File_Type);
|
procedure Modify_File (File : out File_Type);
|
|
|
type File_Dir is limited private;
|
type File_Dir is limited private;
|
|
|
-- The following three validation functions provide the capability to
|
-- The following three validation functions provide the capability to
|
-- check the limited private types defined in the parent and the
|
-- check the limited private types defined in the parent and the
|
-- private child package from within the client program.
|
-- private child package from within the client program.
|
|
|
function Validate_Create (File : in File_Type) return Boolean;
|
function Validate_Create (File : in File_Type) return Boolean;
|
|
|
function Validate_Modification (File : in File_Type)
|
function Validate_Modification (File : in File_Type)
|
return Boolean;
|
return Boolean;
|
|
|
function Validate_Dir (Dir : in File_Dir) return Boolean;
|
function Validate_Dir (Dir : in File_Dir) return Boolean;
|
|
|
private
|
private
|
|
|
-- Since full view of the nontagged File_Type is nonlimited in the parent
|
-- Since full view of the nontagged File_Type is nonlimited in the parent
|
-- package, it is not limited in the private part of the public child, so
|
-- package, it is not limited in the private part of the public child, so
|
-- aggregates are available.
|
-- aggregates are available.
|
|
|
Child_File : File_Type
|
Child_File : File_Type
|
:= File_Type'(Descriptor => Null_File,
|
:= File_Type'(Descriptor => Null_File,
|
Mode => Write_Only,
|
Mode => Write_Only,
|
Name => String2);
|
Name => String2);
|
|
|
-- Since full view of the nontagged component File_Type is nonlimited in
|
-- Since full view of the nontagged component File_Type is nonlimited in
|
-- the parent package, it is not limited in the private part of the public
|
-- the parent package, it is not limited in the private part of the public
|
-- child, so default expressions are available.
|
-- child, so default expressions are available.
|
|
|
type File_Dir is
|
type File_Dir is
|
record
|
record
|
Comp : File_Type := Child_File;
|
Comp : File_Type := Child_File;
|
end record;
|
end record;
|
|
|
end C730004_0.C730004_2;
|
end C730004_0.C730004_2;
|
|
|
--=================================================================--
|
--=================================================================--
|
|
|
with C730004_0.C730004_1;
|
with C730004_0.C730004_1;
|
|
|
package body C730004_0.C730004_2 is
|
package body C730004_0.C730004_2 is
|
|
|
procedure Create_File (File : out File_Type) is
|
procedure Create_File (File : out File_Type) is
|
New_File : File_Type;
|
New_File : File_Type;
|
|
|
begin
|
begin
|
New_File.Descriptor := Next_Available_File;
|
New_File.Descriptor := Next_Available_File;
|
New_File.Mode := Default_Mode;
|
New_File.Mode := Default_Mode;
|
New_File.Name := C730004_0.C730004_1.System_File_Name;
|
New_File.Name := C730004_0.C730004_1.System_File_Name;
|
|
|
if C730004_0.C730004_1.New_File_Validated (New_File) then
|
if C730004_0.C730004_1.New_File_Validated (New_File) then
|
File := New_File;
|
File := New_File;
|
else
|
else
|
File := (Null_File, Lost, "MISSED");
|
File := (Null_File, Lost, "MISSED");
|
end if;
|
end if;
|
|
|
end Create_File;
|
end Create_File;
|
|
|
--------------------------------------------------------------
|
--------------------------------------------------------------
|
procedure Modify_File (File : out File_Type) is
|
procedure Modify_File (File : out File_Type) is
|
begin
|
begin
|
File.Descriptor := Next_Available_File;
|
File.Descriptor := Next_Available_File;
|
File.Mode := Active_Mode;
|
File.Mode := Active_Mode;
|
File.Name := String1;
|
File.Name := String1;
|
end Modify_File;
|
end Modify_File;
|
|
|
--------------------------------------------------------------
|
--------------------------------------------------------------
|
function Validate_Create (File : in File_Type) return Boolean is
|
function Validate_Create (File : in File_Type) return Boolean is
|
begin
|
begin
|
if ((File.Descriptor /= Child_File.Descriptor) and
|
if ((File.Descriptor /= Child_File.Descriptor) and
|
(File.Mode = Read_Only) and (File.Name = "ACVC95"))
|
(File.Mode = Read_Only) and (File.Name = "ACVC95"))
|
then
|
then
|
return True;
|
return True;
|
else
|
else
|
return False;
|
return False;
|
end if;
|
end if;
|
end Validate_Create;
|
end Validate_Create;
|
|
|
------------------------------------------------------------------------
|
------------------------------------------------------------------------
|
function Validate_Modification (File : in File_Type)
|
function Validate_Modification (File : in File_Type)
|
return Boolean is
|
return Boolean is
|
begin
|
begin
|
if ((File.Descriptor /= C730004_0.C730004_1.System_File.Descriptor) and
|
if ((File.Descriptor /= C730004_0.C730004_1.System_File.Descriptor) and
|
(File.Mode = Read_Write) and (File.Name = "ACVC "))
|
(File.Mode = Read_Write) and (File.Name = "ACVC "))
|
then
|
then
|
return True;
|
return True;
|
else
|
else
|
return False;
|
return False;
|
end if;
|
end if;
|
end Validate_Modification;
|
end Validate_Modification;
|
|
|
------------------------------------------------------------------------
|
------------------------------------------------------------------------
|
function Validate_Dir (Dir : in File_Dir) return Boolean is
|
function Validate_Dir (Dir : in File_Dir) return Boolean is
|
begin
|
begin
|
if ((Dir.Comp.Descriptor = C730004_0.C730004_1.System_File.Descriptor)
|
if ((Dir.Comp.Descriptor = C730004_0.C730004_1.System_File.Descriptor)
|
and (Dir.Comp.Mode = Write_Only) and (Dir.Comp.Name = String2))
|
and (Dir.Comp.Mode = Write_Only) and (Dir.Comp.Name = String2))
|
then
|
then
|
return True;
|
return True;
|
else
|
else
|
return False;
|
return False;
|
end if;
|
end if;
|
end Validate_Dir;
|
end Validate_Dir;
|
|
|
end C730004_0.C730004_2;
|
end C730004_0.C730004_2;
|
|
|
--=================================================================--
|
--=================================================================--
|
|
|
with C730004_0.C730004_2;
|
with C730004_0.C730004_2;
|
with Report;
|
with Report;
|
|
|
procedure C730004 is
|
procedure C730004 is
|
|
|
package File renames C730004_0;
|
package File renames C730004_0;
|
package File_Ops renames C730004_0.C730004_2;
|
package File_Ops renames C730004_0.C730004_2;
|
|
|
Validation_File : File.File_Type;
|
Validation_File : File.File_Type;
|
|
|
Validation_Dir : File_Ops.File_Dir;
|
Validation_Dir : File_Ops.File_Dir;
|
|
|
------------------------------------------------------------------------
|
------------------------------------------------------------------------
|
-- Limited File_Type is allowed as an out parameter outside package File.
|
-- Limited File_Type is allowed as an out parameter outside package File.
|
|
|
procedure Call_Modify_File (Modified_File : out File.File_Type) is
|
procedure Call_Modify_File (Modified_File : out File.File_Type) is
|
begin
|
begin
|
File_Ops.Modify_File (Modified_File);
|
File_Ops.Modify_File (Modified_File);
|
end Call_Modify_File;
|
end Call_Modify_File;
|
|
|
begin
|
begin
|
|
|
Report.Test ("C730004", "Check that for a type declared in a package, " &
|
Report.Test ("C730004", "Check that for a type declared in a package, " &
|
"descendants of the package use the full view " &
|
"descendants of the package use the full view " &
|
"of the type. Specifically check that full " &
|
"of the type. Specifically check that full " &
|
"view of the limited type is visible only in " &
|
"view of the limited type is visible only in " &
|
"private children and in the private parts and " &
|
"private children and in the private parts and " &
|
"bodies of public children");
|
"bodies of public children");
|
|
|
File_Ops.Create_File (Validation_File);
|
File_Ops.Create_File (Validation_File);
|
|
|
if not File_Ops.Validate_Create (Validation_File) then
|
if not File_Ops.Validate_Create (Validation_File) then
|
Report.Failed ("Incorrect creation of file");
|
Report.Failed ("Incorrect creation of file");
|
end if;
|
end if;
|
|
|
Call_Modify_File (Validation_File);
|
Call_Modify_File (Validation_File);
|
|
|
if not File_Ops.Validate_Modification (Validation_File) then
|
if not File_Ops.Validate_Modification (Validation_File) then
|
Report.Failed ("Incorrect modification of file");
|
Report.Failed ("Incorrect modification of file");
|
end if;
|
end if;
|
|
|
if not File_Ops.Validate_Dir (Validation_Dir) then
|
if not File_Ops.Validate_Dir (Validation_Dir) then
|
Report.Failed ("Incorrect creation of directory");
|
Report.Failed ("Incorrect creation of directory");
|
end if;
|
end if;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end C730004;
|
end C730004;
|
|
|
