diff gcc/testsuite/ada/acats/tests/c9/c93003a.ada @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/c9/c93003a.ada	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,351 @@
+-- C93003A.ADA
+
+--                             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.
+--*
+-- CHECK THAT ACTIVATION OF TASKS CREATED BY ALLOCATORS PRESENT IN A
+--   DECLARATIVE PART TAKES PLACE DURING ELABORATION OF THE
+--   CORRESPONDING DECLARATION.
+-- SUBTESTS ARE:
+--   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
+--   (B)  AN ARRAY OF TASK ALLOCATOR, IN A FUNCTION.
+--   (C)  A RECORD OF TASK ALLOCATOR, IN A PACKAGE SPECIFICATION.
+--   (D)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A PACKAGE BODY.
+--   (E)  AN ARRAY OF RECORD OF TASK ALLOCATOR, IN A TASK BODY.
+
+-- JRK 9/28/81
+-- SPS 11/11/82
+-- SPS 11/21/82
+-- RJW 8/4/86    ADDED CHECKS ON INITIALIZATIONS OF NON-TASK COMPONENTS
+--               OF RECORD TYPES.
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C93003A IS
+
+     GLOBAL : INTEGER;
+
+     FUNCTION SIDE_EFFECT (I : INTEGER) RETURN INTEGER IS
+     BEGIN
+          GLOBAL := IDENT_INT (I);
+          RETURN 0;
+     END SIDE_EFFECT;
+
+     TASK TYPE TT IS
+          ENTRY E;
+     END TT;
+
+     TASK BODY TT IS
+          I : INTEGER := SIDE_EFFECT (1);
+     BEGIN
+          NULL;
+     END TT;
+
+
+BEGIN
+     TEST ("C93003A", "CHECK THAT ACTIVATION OF TASKS CREATED BY " &
+                      "ALLOCATORS PRESENT IN A DECLARATIVE PART " &
+                      "TAKES PLACE DURING ELABORATION OF THE " &
+                      "CORRESPONDING DECLARATION");
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (A)
+
+          TYPE A IS ACCESS TT;
+          T1 : A := NEW TT;
+          I1 : INTEGER := GLOBAL;
+          J  : INTEGER := SIDE_EFFECT (0);
+          T2 : A := NEW TT;
+          I2 : INTEGER := GLOBAL;
+
+     BEGIN -- (A)
+
+          IF I1 /= 1 OR I2 /= 1 THEN
+               FAILED ("A SIMPLE TASK ALLOCATOR IN A BLOCK WAS " &
+                       "ACTIVATED TOO LATE - (A)");
+          END IF;
+
+     END; -- (A)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (B)
+
+          J : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+
+               TYPE A_T IS ARRAY (1 .. 1) OF TT;
+               TYPE A IS ACCESS A_T;
+               A1 : A := NEW A_T;
+               I1 : INTEGER := GLOBAL;
+               J  : INTEGER := SIDE_EFFECT (0);
+               A2 : A := NEW A_T;
+               I2 : INTEGER := GLOBAL;
+
+          BEGIN
+               IF I1 /= 1 OR I2 /= 1 THEN
+                    FAILED ("AN ARRAY OF TASK ALLOCATOR IN A " &
+                            "FUNCTION WAS ACTIVATED TOO LATE - (B)");
+               END IF;
+               RETURN 0;
+          END F;
+
+     BEGIN -- (B)
+
+          J := F ;
+
+     END; -- (B)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (C1)
+
+          PACKAGE P IS
+
+               TYPE INTREC IS
+                    RECORD
+                         N1 : INTEGER := GLOBAL;
+                    END RECORD;
+
+               TYPE RT IS
+                    RECORD
+                         M : INTEGER := GLOBAL;
+                         T : TT;
+                         N : INTREC;
+                    END RECORD;
+
+               TYPE A IS ACCESS RT;
+
+               R1 : A := NEW RT;
+               I1 : INTEGER := GLOBAL;
+               J  : INTEGER := SIDE_EFFECT (0);
+               R2 : A := NEW RT;
+               I2 : INTEGER := GLOBAL;
+
+          END P;
+
+     BEGIN -- (C1)
+
+          IF P.R1.M /= 0 OR P.R1.N.N1 /= 0 THEN 
+               FAILED ("NON-TASK COMPONENTS OF RECORD R1 NOT " &
+                       "INITIALIZED BEFORE TASK ACTIVATED - (C1)" );
+          END IF;
+
+          IF P.R2.M /= 0 OR P.R2.N.N1 /= 0 THEN 
+               FAILED ("NON-TASK COMPONENTS OF RECORD R2 NOT " &
+                       "INITIALIZED BEFORE TASK ACTIVATED - (C1)" );
+          END IF;
+
+          IF P.I1 /= 1 OR P.I2 /= 1 THEN
+               FAILED ("A RECORD OF TASK ALLOCATOR IN A PACKAGE " &
+                       "SPECIFICATION WAS ACTIVATED TOO LATE - (C1)");
+          END IF;
+
+     END; -- (C1)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (C2)
+
+          PACKAGE Q IS
+               J1 : INTEGER;
+          PRIVATE
+               
+               TYPE GRADE IS (GOOD, FAIR, POOR);
+     
+               TYPE REC (G : GRADE) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+
+               TYPE ACCR IS ACCESS REC;
+
+               TYPE ACCI IS ACCESS INTEGER;
+
+               TYPE RT IS
+                    RECORD
+                         M : ACCR := NEW REC (GRADE'VAL (GLOBAL));
+                         T : TT;
+                         N : ACCI := NEW INTEGER'(GLOBAL);
+                    END RECORD;
+
+               TYPE A IS ACCESS RT;
+
+               R1 : A := NEW RT;
+               I1 : INTEGER := GLOBAL;
+               J2 : INTEGER := SIDE_EFFECT (0);
+               R2 : A := NEW RT;
+               I2 : INTEGER := GLOBAL;
+
+          END Q;
+
+          PACKAGE BODY Q IS
+          BEGIN
+               IF R1.M.G /= GOOD OR R1.N.ALL /= 0 THEN 
+                    FAILED ("NON-TASK COMPONENTS OF RECORD R1 NOT " &
+                            "INITIALIZED BEFORE TASK ACTIVATED " &
+                            "- (C2)" );
+               END IF;
+
+               IF R2.M.G /= GOOD OR R2.N.ALL /= 0 THEN 
+                    FAILED ("NON-TASK COMPONENTS OF RECORD R2 NOT " &
+                            "INITIALIZED BEFORE TASK ACTIVATED " &
+                            "- (C2)" );
+               END IF;
+
+               IF I1 /= 1 OR I2 /= 1 THEN
+                    FAILED ("A RECORD OF TASK ALLOCATOR IN A PACKAGE " &
+                            "SPECIFICATION WAS ACTIVATED TOO LATE " &
+                            "- (C2)");
+               END IF;
+          END Q;
+
+     BEGIN -- (C2)
+
+          NULL;
+
+     END; -- (C2)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (D)
+
+          PACKAGE P IS
+
+               TYPE ARR IS ARRAY (1 .. 1) OF TT;
+               TYPE INTARR IS ARRAY (1 .. 1) OF INTEGER;
+
+               TYPE RAT IS
+                    RECORD
+                         M : INTARR := (1 => GLOBAL);
+                         A : ARR;
+                         N : INTARR := (1 => GLOBAL);
+                    END RECORD;
+          END P;
+
+          PACKAGE BODY P IS
+
+               TYPE A IS ACCESS RAT;
+
+               RA1 : A := NEW RAT;
+               I1  : INTEGER := GLOBAL;
+               J   : INTEGER := SIDE_EFFECT (0);
+               RA2 : A := NEW RAT;
+               I2  : INTEGER := GLOBAL;
+
+          BEGIN
+               IF RA1.M (1) /= 0 OR RA1.N (1) /= 0 THEN 
+                    FAILED ("NON-TASK COMPONENTS OF RECORD RA1 NOT " &
+                            "INITIALIZED BEFORE TASK ACTIVATED " &
+                            "- (D)" );
+               END IF;
+
+               IF RA2.M (1) /= 0 OR RA2.N (1) /= 0 THEN 
+                    FAILED ("NON-TASK COMPONENTS OF RECORD RA2 NOT " &
+                            "INITIALIZED BEFORE TASK ACTIVATED " &
+                            "- (D)" );
+               END IF;
+
+               IF I1 /= 1 OR I2 /= 1 THEN
+                    FAILED ("A RECORD OF ARRAY OF TASK ALLOCATOR IN " &
+                            "A PACKAGE BODY WAS ACTIVATED " &
+                            "TOO LATE - (D)");
+               END IF;
+          END P;
+
+     BEGIN -- (D)
+
+          NULL;
+
+     END; -- (D)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (E)
+
+          TASK T IS
+               ENTRY E;
+          END T;
+
+          TASK BODY T IS
+               TYPE RT IS
+                    RECORD
+                         M : BOOLEAN := BOOLEAN'VAL (GLOBAL);
+                         T : TT;
+                         N : CHARACTER := CHARACTER'VAL (GLOBAL);
+                    END RECORD;
+
+               TYPE ART IS ARRAY (1 .. 1) OF RT;
+               TYPE A IS ACCESS ART;
+
+               AR1 : A := NEW ART;
+               I1  : INTEGER := GLOBAL;
+               J   : INTEGER := SIDE_EFFECT (0);
+               AR2 : A := NEW ART;
+               I2  : INTEGER := GLOBAL;
+
+          BEGIN
+               IF AR1.ALL (1).M /= FALSE     OR 
+                  AR1.ALL (1).N /= ASCII.NUL THEN 
+                    FAILED ("NON-TASK COMPONENTS OF RECORD AR1 NOT " &
+                            "INITIALIZED BEFORE TASK ACTIVATED " &
+                            "- (E)" );
+               END IF;
+
+               IF AR2.ALL (1).M /= FALSE     OR 
+                  AR2.ALL (1).N /= ASCII.NUL THEN 
+                    FAILED ("NON-TASK COMPONENTS OF RECORD AR2 NOT " &
+                            "INITIALIZED BEFORE TASK ACTIVATED " &
+                            "- (E)" );
+               END IF;
+
+               IF I1 /= 1 OR I2 /= 1 THEN
+                    FAILED ("AN ARRAY OF RECORD OF TASK ALLOCATOR IN " &
+                            "A TASK BODY WAS ACTIVATED TOO LATE - (E)");
+               END IF;
+          END T;
+
+     BEGIN -- (E)
+
+          NULL;
+
+     END; -- (E)
+
+     --------------------------------------------------
+
+     RESULT;
+END C93003A;