old-autovect-branch/gcc/testsuite/ada/acats/support/fc54a00.a

   1 -- FC54A00.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 types which will serve as designated
  28 --      types for tests involving generic formal access types (including
  29 --      access-to-subprogram types).
  30 --
  31 -- CHANGE HISTORY:
  32 --      06 Dec 94   SAIC    ACVC 2.0
  33 --
  34 --!
  35
  36 package FC54A00 is
  37
  38
  39    -- Discrete (integer) types:
  40
  41    Bits : constant := 8;                    -- Named number.
  42
  43    type    Numerals           is range -256 .. 255;
  44    type    New_Numerals       is new Numerals range -128 .. 127;
  45    subtype Positives          is Numerals range 0 .. 255;
  46    subtype Same_Numerals      is Numerals;
  47    subtype Numerals_Static    is Numerals range -2**Bits .. 2**Bits - 1;
  48
  49    Min  : Numerals  := Numerals'First;      -- Variable.
  50    Max  : Integer   := 255;                 -- Variable.
  51
  52    subtype Numerals_Nonstatic is Numerals  range Min .. 255;
  53    subtype Positive_Nonstatic is Positives range 0 .. Positives(Max);
  54    subtype Pos_Dupl_Nonstatic is Positives range 0 .. Positives(Max);
  55    subtype Pos_Attr_Nonstatic is Positives range Positive_Nonstatic'Range;
  56
  57
  58
  59    -- Floating point types:
  60
  61    type    Float_Type       is digits 3;
  62    type    New_Float        is new Float_Type;
  63    subtype Float_100        is Float_Type range 0.0 .. 100.0;
  64    subtype Same_Float       is Float_Type;
  65
  66    Hundred : constant := 100.0;             -- Named number.
  67
  68    type    Float_With_Range is digits 3 range 0.0 .. 100.0;
  69    subtype Float_Same_Range is Float_With_Range range 0.0 .. Hundred;
  70
  71
  72
  73    -- Tagged record types:
  74
  75    subtype Lengths is Natural range 0 .. 50;
  76
  77    type Parent is abstract tagged null record;
  78
  79    type Tag (Len: Lengths) is new Parent with record
  80       Msg : String (1 .. Len);
  81    end record;
  82
  83    type New_Tag is new Tag with record
  84       Sent : Boolean;
  85    end record;
  86
  87    subtype Same_Tag is Tag;
  88
  89    Twenty : constant := 20;                 -- Named number.
  90
  91    subtype Tag20      is Tag (Len => 20);
  92    subtype Tag25      is Tag (25);
  93    subtype Tag_Twenty is Tag (Twenty);
  94
  95    My_Len : Lengths := Twenty;              -- Variable.
  96    subtype Sub_Length is Lengths range 1 .. My_Len;
  97
  98    subtype Tag20_Nonstatic      is Tag (Len => Sub_Length'Last);
  99    subtype Tag20_Dupl_Nonstatic is Tag (Sub_Length'Last);
 100    subtype Tag20_Same_Nonstatic is Tag20_Nonstatic;
 101    subtype Tag20_Var_Nonstatic  is Tag (Len => My_Len);
 102
 103
 104
 105    -- Access types (designated type is tagged):
 106
 107    type Tagged_Ptr         is access Tag;
 108    type Tag_Class_Ptr      is access Tag'Class;
 109
 110    subtype Msg_Ptr_Static  is Tagged_Ptr(Twenty);
 111
 112
 113
 114    -- Array types:
 115
 116    type    New_String  is new String;
 117    subtype Same_String is String;
 118
 119    Ten : constant := 10;                    -- Named number.
 120
 121    subtype Msg_Static  is     String(1 .. Ten);
 122    type    Msg10       is new String(1 .. 10);
 123    subtype Msg20       is     String(1 .. 20);
 124
 125    Size : Positive := 10;
 126
 127    subtype Msg_Nonstatic      is String(1 .. Size);
 128    subtype Msg_Dupl_Nonstatic is String(1 .. Size);
 129    subtype Msg_Same_Nonstatic is Msg_Nonstatic;
 130
 131
 132 end FC54A00;