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

   1 -- F954A00.A
   2 --
   3 --
   4 --                             Grant of Unlimited Rights
   5 --
   6 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   7 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   8 --     unlimited rights in the software and documentation contained herein.
   9 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
  10 --     this public release, the Government intends to confer upon all
  11 --     recipients unlimited rights  equal to those held by the Government.
  12 --     These rights include rights to use, duplicate, release or disclose the
  13 --     released technical data and computer software in whole or in part, in
  14 --     any manner and for any purpose whatsoever, and to have or permit others
  15 --     to do so.
  16 --
  17 --                                    DISCLAIMER
  18 --
  19 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  20 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  21 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  22 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  23 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  24 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  25 --*
  26 --
  27 -- OBJECTIVE:
  28 --      This file contains foundation code for tests covering the requeue
  29 --      statement.
  30 --
  31 -- TEST DESCRIPTION:
  32 --      See prologues of specific tests.
  33 --
  34 -- CHANGE HISTORY:
  35 --      06 Dec 94   SAIC    ACVC 2.0
  36 --
  37 --!
  38
  39 package F954A00 is  -- Printer device abstraction.
  40
  41
  42    -- Model a printer device driver as a protected type. A printer remains
  43    -- unavailable while data is printing. The printer generates an interrupt
  44    -- when printing is complete, after which the printer is again made
  45    -- available.
  46
  47
  48    type Printers_Info is tagged record
  49       Some_Info : Integer;
  50    end record;
  51
  52                --==============================================--
  53
  54    protected type Printers is   -- Device driver for printer.
  55
  56       procedure Start_Printing (File_Name : String);  -- Begin printing on
  57                                                       -- printer.
  58
  59       procedure Handle_Interrupt;                     -- Handle interrupt from
  60                                                       -- printer.
  61
  62       entry Done_Printing;                            -- Wait until printer is
  63                                                       -- done.
  64
  65       function Available return Boolean;              -- Return value of Ready.
  66       function Is_Done return Boolean;                -- Return value of Done.
  67
  68    private
  69
  70       Ready : Boolean := True;                        -- Entry barrier.
  71       Done  : Boolean := True;                        -- Testing flag.
  72
  73    end Printers;
  74
  75                --==============================================--
  76
  77    Number_Of_Printers : constant := 2;
  78
  79    type Printer_ID is range 1 .. Number_Of_Printers;
  80
  81    type Printer_Array is array (Printer_ID) of Printers;
  82    type Info_Array    is array (Printer_ID) of Printers_Info;
  83
  84    Printer       : Printer_Array;
  85    Printer_Info  : constant Info_Array  := ( (Some_Info => 1),
  86                                              (Some_Info => 2) );
  87
  88 end F954A00;
  89
  90
  91      --==================================================================--
  92
  93
  94 package body F954A00 is  -- Printer server abstraction.
  95
  96
  97    protected body Printers is
  98
  99       procedure Start_Printing (File_Name : String) is
 100       begin
 101          Ready := False;                              -- Block other requests
 102          Done  := False;                              -- for this printer
 103          -- Send data to the printer...               -- and begin printing.
 104       end Start_Printing;
 105
 106
 107       -- Set the "not ready" one-shot
 108       entry Done_Printing when Ready is               -- Callers wait here
 109       begin                                           -- until printing is
 110          Done := True;                                -- done (signaled by a
 111       end Done_Printing;                              -- printer interrupt).
 112
 113
 114       procedure Handle_Interrupt is                   -- Called when the
 115       begin                                           -- printer interrupts,
 116          Ready := True;                               -- indicating that
 117       end Handle_Interrupt;                           -- printing is done.
 118
 119
 120       function Available return Boolean is            -- Artifice for test
 121       begin                                           -- purposes: checks
 122          return (Ready);                              -- whether printer is
 123       end Available;                                  -- still printing.
 124
 125
 126       function Is_Done return Boolean is              -- Artifice for test
 127       begin                                           -- purposes: checks
 128          return (Done);                               -- whether Done_Printing
 129       end Is_Done;                                    -- entry was executed.
 130
 131    end Printers;
 132
 133
 134 end F954A00;