gcc/testsuite/ada/acats/support/fxc6a00.a

   1 -- FXC6A00.A
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 --
  26 -- FOUNDATION DESCRIPTION:
  27 --     This foundation declares various volatile and non-volatile types. Some
  28 --     are by-reference types, and some allow pass-by-copy.
  29 --
  30 -- CHANGE HISTORY:
  31 --      23 Jan 96   SAIC    Initial version for ACVC 2.1.
  32 --      02 DEC 97   EDS     Removed Pragma Volatile applied to composite types.
  33 --      27 AUG 99   RLB     Repaired so Nonvolatile_Tagged really is
  34 --                          Nonvolatile.
  35 --!
  36
  37 package FXC6A00 is
  38
  39    type Roman is ('I', 'V', 'X', 'L', 'C', 'D', 'M');  -- By-copy type.
  40
  41    type Acc_Roman is access all Roman;
  42
  43
  44    type Tagged_Type is tagged record                   -- By-reference type.
  45       C: Natural;
  46    end record;
  47
  48
  49    type Volatile_Tagged is new Tagged_Type with record -- Volatile by-reference
  50       R1: Roman;                                       -- type.
  51    end record;
  52    pragma Volatile (Volatile_Tagged);
  53
  54    type Acc_Volatile_Tagged is access all Volatile_Tagged;
  55
  56                                                        -- By-reference type.
  57    type NonVolatile_Tagged is new Tagged_Type with record
  58       R2: aliased Roman;
  59    end record;
  60
  61
  62    task type Task_Type is                              -- By-reference type.
  63       entry Calculate (C: in out Natural);
  64    end Task_Type;
  65
  66    type Acc_Task_Type is access all Task_Type;
  67
  68
  69    protected type Protected_Type is                    -- By-reference type.
  70       procedure Op;
  71    private
  72       Count : Natural := 0;
  73    end Protected_Type;
  74
  75
  76    protected type Volatile_Protected is                -- Volatile by-reference
  77       procedure Handler;                               -- type.
  78       pragma Interrupt_Handler (Handler);
  79
  80       function Handled return Boolean;
  81    private
  82       Was_Handled : Boolean := False;
  83    end Volatile_Protected;
  84    pragma Volatile (Volatile_Protected);
  85
  86    type Acc_Vol_Protected is access all Volatile_Protected;
  87
  88
  89    type Record_Type is record                          -- Allows pass-by-copy.
  90       C: String(1 .. 2);
  91    end record;
  92
  93
  94    type Volatile_Record is limited record              -- Volatile by-reference
  95       C: String(1 .. 2);                               -- type.
  96    end record;
  97    pragma Volatile (Volatile_Record);
  98
  99
 100    type Composite_Type is record                       -- By-reference type.
 101       C: Tagged_Type;
 102       D: aliased Volatile_Tagged;                      -- Volatile component.
 103    end record;
 104
 105
 106    type Private_Type is private;                       -- By-reference type.
 107
 108
 109    type Array_Type is array (1..3) of Tagged_Type;     -- By-reference type.
 110    pragma Volatile_Components (Array_Type);
 111
 112    type Acc_Array_Type is access all Array_Type;
 113
 114
 115    type Lim_Private_Type is limited private;           -- By-copy type.
 116
 117 private
 118
 119    type Private_Type is new Tagged_Type with record
 120       D: Character;
 121    end record;
 122
 123
 124    type Lim_Private_Type is new Integer;
 125
 126 end FXC6A00;
 127
 128
 129      --==================================================================--
 130
 131
 132 package body FXC6A00 is
 133
 134    task body Task_Type is
 135    begin
 136       accept Calculate (C: in out Natural) do
 137          C := C * 10;
 138       end Calculate;
 139    end Task_Type;
 140
 141
 142    protected body Protected_Type is
 143       procedure Op is
 144       begin
 145          Count := Count + 1;
 146       end Op;
 147    end Protected_Type;
 148
 149
 150    protected body Volatile_Protected is
 151       procedure Handler is
 152       begin
 153          Was_Handled := True;
 154       end Handler;
 155
 156       function Handled return Boolean is
 157       begin
 158          return Was_Handled;
 159       end Handled;
 160    end Volatile_Protected;
 161
 162 end FXC6A00;