old-autovect-branch/gcc/testsuite/ada/acats/tests/c6/c631001.a

   1 -- C631001.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 -- OBJECTIVE:
  27 --      Check that if different forms of a name are used in the default
  28 --      expression of a discriminant part, the selector may be an operator
  29 --      symbol or a character literal.
  30 --
  31 -- TEST DESCRIPTION:
  32 --      This transition test defines private types where their selectors in
  33 --      the default expression of the discriminant parts at the full type
  34 --      declarations are an operator and a literal, respectively.
  35 --      The test also declares procedures that use an operator and a literal
  36 --      as selectors in the formal parts.
  37 --
  38 --      Inspired by B63102A.ADA.
  39 --
  40 --
  41 -- CHANGE HISTORY:
  42 --      25 Mar 96   SAIC    Initial version for ACVC 2.1.
  43 --      26 Feb 97   PWB.CTA Removed use of function called before elaboration
  44 --!
  45
  46 with Report;
  47
  48 procedure C631001 is
  49
  50    package C631001_0 is
  51
  52       type Int_Type is range 1 .. 100;
  53       type Enu_Type is ('A', 'B', 'C', 'D');
  54
  55       type Private_Enu (D : Enu_Type := 'B')       is private;
  56
  57       function "+" (X, Y : Int_Type) return Int_Type;
  58
  59       procedure Int_Proc (P1 : in  Int_Type := "+" (10, 15);
  60                           P2 : out Int_Type);
  61
  62       procedure Enu_Proc (P1 : in  Enu_Type := 'C';
  63                           P2 : out Enu_Type);
  64
  65    private
  66
  67       type Private_Enu (D : Enu_Type := C631001_0.'B') is              -- OK.
  68         record
  69            C2 : Enu_Type := D;
  70         end record;
  71
  72       -----------------------------------------------------------------
  73       PE_Obj  : C631001_0.Private_Enu;
  74
  75    end C631001_0;
  76
  77      --==================================================================--
  78
  79    package body C631001_0 is
  80
  81       function "+" (X, Y : Int_Type) return Int_Type is
  82       begin
  83          return 10;
  84       end "+";
  85
  86       -----------------------------------------------------------------
  87       procedure Int_Proc (P1 : in  Int_Type := C631001_0."+" (10, 15); -- OK.
  88                           P2 : out Int_Type) is
  89
  90       begin
  91          P2 := P1;
  92       end Int_Proc;
  93
  94       -----------------------------------------------------------------
  95       procedure Enu_Proc (P1 : in  Enu_Type := C631001_0.'C';          -- OK.
  96                           P2 : out Enu_Type) is
  97       begin
  98          P2 := P1;
  99       end Enu_Proc;
 100
 101       -----------------------------------------------------------------
 102
 103    end C631001_0;
 104
 105    ---------------------------------------------------------------------------
 106    Int_Obj : C631001_0.Int_Type := 50;
 107    Enu_Obj : C631001_0.Enu_Type := C631001_0.'D';
 108
 109    -- Direct visibility to operator symbols
 110    use type C631001_0.Int_Type;
 111    use type C631001_0.Enu_Type;
 112
 113 begin  -- main
 114
 115    Report.Test ("C631001", "Check that if different forms of a name are " &
 116                 "used in the default expression of a discriminant part, " &
 117                 "the selector may be an operator symbol or a character "  &
 118                 "literal");
 119
 120    C631001_0.Int_Proc (P2 => Int_Obj);
 121
 122    if Int_Obj /= 10 then
 123      Report.Failed ("Wrong result for Int_Obj");
 124    end if;
 125
 126    C631001_0.Enu_Proc (P2 => Enu_Obj);
 127
 128    if Enu_Obj /= 'C' then
 129      Report.Failed ("Wrong result for Enu_Obj");
 130    end if;
 131
 132    Report.Result;
 133
 134 end C631001;