old-autovect-branch/gcc/testsuite/ada/acats/tests/c3/c3a0004.a

   1 -- C3A0004.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 access to subprogram may be stored within array
  28  --      objects, and that the access to subprogram can subsequently
  29  --      be called.
  30  --
  31  -- TEST DESCRIPTION:
  32  --      Declare an access to procedure type in a package specification.
  33  --      Declare an array of the access type.  Declare three different
  34  --      procedures that can be referred to by the access to procedure type.
  35  --
  36  --      In the main program, build the array by dereferencing the access
  37  --      value.
  38  --
  39  --
  40 -- CHANGE HISTORY:
  41 --      06 Dec 94   SAIC    ACVC 2.0
  42 --
  43  --!
  44
  45  with Report;
  46
  47  procedure C3A0004 is
  48
  49     Left_Turn   : Integer  := 1;
  50
  51     Right_Turn  : Integer  := 1;
  52
  53     Center_Turn : Integer  := 1;
  54
  55     -- Type accesses to any procedure
  56     type Action_Ptr is access procedure;
  57
  58     -- Array of access to procedure
  59     type Action_Array is array (Integer range <>) of Action_Ptr;
  60
  61
  62     procedure Rotate_Left is
  63     begin
  64        Left_Turn := 2;
  65     end Rotate_Left;
  66
  67
  68     procedure Rotate_Right is
  69     begin
  70        Right_Turn := 3;
  71     end Rotate_Right;
  72
  73
  74     procedure Center is
  75     begin
  76        Center_Turn := 0;
  77     end Center;
  78
  79
  80  begin
  81
  82     Report.Test ("C3A0004", "Check that access to subprogram may be "
  83                           & "stored within data structures, and that the "
  84                           & "access to subprogram can subsequently be called");
  85
  86     ------------------------------------------------------------------------
  87
  88     declare
  89        Total_Actions   : constant := 3;
  90        Action_Sequence : Action_Array (1 .. Total_Actions);
  91
  92     begin
  93
  94        -- Build the action sequence
  95        Action_Sequence := (Rotate_Left'Access, Center'Access,
  96                            Rotate_Right'Access);
  97
  98        -- Assign actions by invoking subprogram designated by access value
  99        for I in Action_Sequence'Range loop
 100           Action_Sequence(I).all;
 101        end loop;
 102
 103        If Left_Turn /= 2 or Right_Turn /= 3
 104           or Center_Turn /= 0 then
 105              Report.Failed ("Incorrect Action sequence result");
 106        end if;
 107
 108      end;
 109
 110     ------------------------------------------------------------------------
 111
 112     Report.Result;
 113
 114  end C3A0004;
 115