diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/support/fa11b00.a')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/support/fa11b00.a | 110 |
1 files changed, 110 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fa11b00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fa11b00.a new file mode 100644 index 000000000..161be8e17 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fa11b00.a @@ -0,0 +1,110 @@ +-- FA11B00.A +-- +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- +-- FOUNDATION DESCRIPTION: +-- This foundation declares parent types and operations that can +-- be inherited by its children. +-- +-- CHANGE HISTORY: +-- 06 Dec 94 SAIC ACVC 2.0 +-- +--! + +package FA11B00 is -- Application_One_Widget +-- This foundation simulates code that might be obtained as an already +-- implemented set of objects and services, perhaps from a source code +-- vendor. It represents processing of widgets in a window system. +-- These widgets all have the same characteristics, but they are application +-- specific, so we do not allow assignment of an App_1_Widget to App_2_Widget. + +-- The dimension measurement is in pixels (dots on the screen). + type Pixels is range 0 .. 10_000; + type Widget_Id is new Integer; + type Widget_Color_Enum is (Amber, Green, White, None); + subtype Widget_Label_Str is string (1 .. 15); + + type Widget_Location is + record + X_Location, Y_Location : Pixels; + end record; + + type Widget_Size is + record + X_Length, Y_Length : Pixels; + end record; + + -- NOTE : not a tagged record. + type App1_Widget (Maximum_Size : Pixels := Pixels'Last) + is record -- Parent type + Size : Widget_Size := (Maximum_Size, Maximum_Size); + ID : Widget_Id := 1; + Location : Widget_Location := (0,0); + Color : Widget_Color_Enum := None; + Label : Widget_Label_Str := " "; + end record; + + -- Primitive operation of type Widget. + -- To be inherited by its children derivatives. + procedure App1_Widget_Specific_Oper (The_Widget : in out App1_Widget; + I : in Widget_Id; + C : in Widget_Color_Enum; + L : in Widget_Label_Str); + +end FA11B00; -- Application_One_Widget + +--=======================================================================-- + +package body FA11B00 is -- Application_One_Widget + + procedure Set_Color (The_Widget : in out App1_Widget; + C : in Widget_Color_Enum) is + begin + The_Widget.Color := C; + end Set_Color; + ------------------------------------------------------------- + procedure Set_Label (The_Widget : in out App1_Widget; + L : in Widget_Label_Str) is + begin + The_Widget.Label := L; + end Set_Label; + ------------------------------------------------------------- + procedure Set_Id (The_Widget : in out App1_Widget; + I : in Widget_Id) is + begin + The_Widget.Id := I; + end Set_Id; + ------------------------------------------------------------- + procedure App1_Widget_Specific_Oper + (The_Widget : in out App1_Widget; + I : in Widget_Id; + C : in Widget_Color_Enum; + L : in Widget_Label_Str) is + begin + Set_Color (The_Widget, C); + Set_Label (The_Widget, L); + Set_Id (The_Widget, I); + end App1_Widget_Specific_Oper; + +end FA11B00; -- Application_One_Widget |