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