diff gcc/testsuite/ada/acats/tests/ca/ca11006.a @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/ca/ca11006.a	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,211 @@
+-- CA11006.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 the private part of a child library unit can utilize
+--      its parent unit's private definition.
+--
+-- TEST DESCRIPTION:
+--      Declare a package and public child package, both with private 
+--      parts.  The child package will have a private extension of a type 
+--      declared in the parent's private part.  In addition, the private 
+--      part of the child package specification will make use of some of 
+--      the components declared in the private part of the parent.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+--
+--!
+
+package CA11006_0 is      -- Package File_Package 
+
+   type File_Descriptor is private;
+   type File_Mode       is (Read_Only, Write_Only, Read_Write);
+   type File_Type       is tagged private;
+
+   function  Next_Available_File return File_Descriptor;
+
+private
+
+   type File_Measure    is range 0 .. 1000;
+   type File_Descriptor is new Integer;
+
+   Null_File       : constant File_Descriptor := 0;
+   Default_Mode    : constant File_Mode       := Read_Write;
+
+   type File_Type is tagged
+     record
+        Descriptor : File_Descriptor := Null_File;
+        Mode       : File_Mode       := Default_Mode;
+     end record;
+
+   System_File : File_Type;
+
+end CA11006_0;               -- Package File_Package  
+
+     --=================================================================--
+
+package body CA11006_0 is    -- Package File_Package  
+   
+   File_Count : Integer := 0;
+
+   function Next_Available_File return File_Descriptor is
+   begin
+      File_Count := File_Count + 1;
+      return File_Descriptor (File_Count);
+   end Next_Available_File;
+
+end CA11006_0;               -- Package File_Package   
+
+     --=================================================================--
+
+package CA11006_0.CA11006_1 is        -- Child package File_Package.Operations
+
+   type File_Length_Type   is private;
+   type Extended_File_Type is new File_Type with private;
+
+   System_Extended_File : constant Extended_File_Type;
+
+   procedure Create_File (Mode : in     File_Mode;
+                          File :    out Extended_File_Type);    
+
+   procedure Compress_File (Original        : in     Extended_File_Type;
+                            Compressed_File :    out Extended_File_Type);
+
+   function  Validate (File : in Extended_File_Type) return Boolean;
+
+   function  Validate_Compression (File : in Extended_File_Type) 
+     return Boolean;
+                                   -- These two validation functions provide
+                                   -- the capability to check the private
+                                   -- components defined in the parent and
+                                   -- child packages from within the client
+                                   -- program.
+private
+
+   type File_Length_Type is new File_Measure;       -- Parent private type.
+
+   Min_File_Size : File_Length_Type := File_Length_Type'First;
+   Max_File_Size : File_Length_Type := File_Length_Type'Last;
+
+   type Extended_File_Type is new File_Type with        -- Parent type.
+      record
+         Blocks : File_Length_Type := Min_File_Size;
+      end record;
+
+   System_Extended_File : constant Extended_File_Type :=
+     (Descriptor => System_File.Descriptor,      -- Parent private object.
+      Mode       => Read_Only,                   -- Parent enumeration literal.
+      Blocks     => Min_File_Size);
+
+
+end CA11006_0.CA11006_1;             -- Child Package File_Package.Operations
+
+     --=================================================================--
+
+                                -- Child package body File_Package.Operations
+package body CA11006_0.CA11006_1 is  
+
+   procedure Create_File 
+     (Mode : in     File_Mode; 
+      File :    out Extended_File_Type) is                 
+   begin
+      File.Descriptor := Next_Available_File;    -- Parent subprogram.
+      File.Mode       := Default_Mode;           -- Parent private constant.
+      File.Blocks     := Max_File_Size;
+   end Create_File;
+   ------------------------------------------------------------------------
+   procedure Compress_File (Original        : in     Extended_File_Type;
+                            Compressed_File :    out Extended_File_Type) is
+   begin
+      Compressed_File.Descriptor := Next_Available_File;      
+      Compressed_File.Mode       := Read_Only;
+      Compressed_File.Blocks     := Original.Blocks / 2;  -- Simulated file
+   end Compress_File;                                     -- compression.
+   ------------------------------------------------------------------------
+   function  Validate (File : in Extended_File_Type) return Boolean is      
+   begin
+      if ((File.Descriptor /= System_Extended_File.Descriptor) and    
+          (File.Mode = Read_Write)                             and
+          (File.Blocks = Max_File_Size))                       then
+         return True;
+      else
+         return False;
+      end if;
+   end Validate;
+   ------------------------------------------------------------------------
+   function  Validate_Compression (File : in Extended_File_Type) 
+      return Boolean is      
+   begin
+      if ((File.Descriptor /= System_File.Descriptor) and    
+          (File.Mode = Read_Only)                     and
+          (File.Blocks = Max_File_Size/2))            then
+         return True;
+      else
+         return False;
+      end if;
+   end Validate_Compression;
+
+end CA11006_0.CA11006_1;         -- Child package body File_Package.Operations
+
+     --=================================================================--
+
+with CA11006_0.CA11006_1;        -- with Child package File_Package.Operations
+with Report;
+
+procedure CA11006 is
+
+   package File      renames CA11006_0;
+   package File_Ops  renames CA11006_0.CA11006_1;            
+
+   Validation_File_Mode : File.File_Mode := File.Read_Only;
+   Validation_File,
+   Storage_Copy         : File_Ops.Extended_File_Type;     
+
+begin
+
+   Report.Test ("CA11006", "Check that the private part of a child "  &
+                           "library unit can utilize its parent "     &
+                           "unit's private definition");
+
+   File_Ops.Create_File (Validation_File_Mode, Validation_File);
+
+   if not File_Ops.Validate (Validation_File) then
+      Report.Failed ("Incorrect initialization of file");
+   end if;
+
+   File_Ops.Compress_File (Validation_File, Storage_Copy);
+
+   if not (File_Ops.Validate (Validation_File) and 
+           File_Ops.Validate_Compression (Storage_Copy))
+   then
+      Report.Failed ("Incorrect compression of file");
+   end if;
+
+   Report.Result;
+
+end CA11006;