gcc/testsuite/ada/acats/tests/cd/cd1c06a.tst

   1 -- CD1C06A.TST
   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 -- OBJECTIVE:
  26 --     CHECK THAT THE EXPRESSION IN A TASK STORAGE SIZE CLAUSE
  27 --     IS NOT EVALUATED AGAIN WHEN A DERIVED TYPE INHERITS THE
  28 --     STORAGE SIZE OF THE PARENT.
  29
  30 -- MACRO SUBSTITUTION:
  31 --     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
  32 --     THE ACTIVATION OF A TASK.
  33
  34 -- HISTORY:
  35 --     JET 09/21/87  CREATED ORIGINAL TEST.
  36 --     DHH 03/30/89  CHANGED SPECIFIED_SIZE TO A MACRO VALUE AND CHANGED
  37 --                   EXTENSION FROM '.DEP' TO '.TST'.
  38
  39 WITH REPORT; USE REPORT;
  40 PROCEDURE CD1C06A IS
  41
  42      I : INTEGER := 0;
  43
  44      SPECIFIED_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
  45
  46      FUNCTION COUNT_SIZE RETURN INTEGER IS
  47      BEGIN
  48           I := I + 1;
  49           RETURN SPECIFIED_SIZE * I;
  50      END;
  51
  52 BEGIN
  53
  54      TEST("CD1C06A", "CHECK THAT THE EXPRESSION IN A TASK STORAGE " &
  55                      "SIZE CLAUSE IS NOT EVALUATED AGAIN WHEN A " &
  56                      "DERIVED TYPE INHERITS THE STORAGE SIZE OF " &
  57                      "THE PARENT");
  58
  59      DECLARE
  60
  61           TASK TYPE PARENT IS
  62                ENTRY E;
  63           END PARENT;
  64
  65           FOR PARENT'STORAGE_SIZE USE COUNT_SIZE;
  66
  67           TYPE DERIVED_TYPE IS NEW PARENT;
  68
  69           TASK BODY PARENT IS
  70           BEGIN
  71                ACCEPT E DO
  72                     COMMENT ("ENTRY E ACCEPTED");
  73                END E;
  74           END PARENT;
  75
  76      BEGIN
  77           IF PARENT'STORAGE_SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
  78                FAILED ("PARENT'STORAGE_SIZE SHOULD NOT BE " &
  79                        "LESS THAN" & INTEGER'IMAGE (SPECIFIED_SIZE) &
  80                        ".  ACTUAL SIZE IS" &
  81                        INTEGER'IMAGE(PARENT'STORAGE_SIZE));
  82           END IF;
  83
  84           IF DERIVED_TYPE'STORAGE_SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
  85                FAILED ("DERIVED_TYPE'STORAGE_SIZE SHOULD NOT BE " &
  86                        "LESS THAN" & INTEGER'IMAGE(SPECIFIED_SIZE) &
  87                        ".  ACTUAL SIZE IS" &
  88                        INTEGER'IMAGE(DERIVED_TYPE'STORAGE_SIZE));
  89           END IF;
  90
  91           IF I > IDENT_INT (1) THEN
  92                FAILED ("THE EXPRESSION FOR THE STORAGE SIZE " &
  93                        "SPECIFICATION WAS EVALUATED MORE THAN ONCE");
  94           END IF;
  95
  96      END;
  97
  98      RESULT;
  99
 100 END CD1C06A;