c84002a.ada

用于进行gcc测试

-- C84002A.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:

--   A) IF A USE CLAUSE NAMES AN ENCLOSING PACKAGE, THE USE CLAUSE
--      HAS NO EFFECT.

--   B) IF A DECLARATION IS DIRECTLY VISIBLE PRIOR TO THE OCCURRENCE
--      OF A USE CLAUSE, AND IS NOT IN THE SET OF POTENTIALLY
--      VISIBLE DECLARATIONS, IT REMAINS DIRECTLY VISIBLE AFTER THE
--      USE CLAUSE.

--   C) IF A HOMOGRAPH FOR A POTENTIALLY VISIBLE SUBPROGRAM OR
--      OBJECT IS DECLARED AFTER A USE CLAUSE, THE POTENTIALLY
--      VISIBLE ENTITY IS NO LONGER VISIBLE.

-- EG  02/16/84

WITH REPORT;

PROCEDURE C84002A IS

     USE REPORT;

BEGIN

     TEST("C84002A","CHECK THAT DECLARATIONS DIRECTLY VISIBLE PRIOR " &
                    "TO THE USE CLAUSE REMAIN VISIBLE AFTERWARDS");

     BEGIN

          COMMENT ("CASE A : CHECK THAT IF A USE CLAUSE NAMES AN " &
                   "ENCLOSING PACKAGE, THE USE CLAUSE HAS NO EFFECT");

CASE_A :  DECLARE

               PACKAGE P1 IS
                    X : FLOAT := 1.5;
               END P1;
               PACKAGE P2 IS
                    X : INTEGER := 15;

                    USE P1;
                    USE P2;

                    A : INTEGER := X;
               END P2;
               PACKAGE BODY P1 IS
               BEGIN
                    NULL;
               END P1;
               PACKAGE BODY P2 IS
               BEGIN
                    IF X /= IDENT_INT(15) OR X /= P2.X OR
                       A /= P2.X THEN
                         FAILED ("CASE A : USE CLAUSE HAS AN EFFECT");
                    END IF;
               END P2;

          BEGIN

               NULL;

          END CASE_A;

          COMMENT ("CASE B : CHECK THAT IF A DECLARATION IS DIRECTLY " &
                   "VISIBLE PRIOR TO THE OCCURRENCE OF A USE CLAUSE, " &
                   "AND IS NOT IN THE SET OF POTENTIALLY VISIBLE "     &
                   "DECLARATIONS, IT REMAINS DIRECTLY VISIBLE");

CASE_B :  BEGIN

     CASE_B1 : DECLARE

                    PACKAGE P1 IS
                         Y : FLOAT := 1.5;
                    END P1;
                    PACKAGE P2 IS
                         X : INTEGER := 15;

                         USE P1;

                         A : INTEGER := X;
                    END P2;

                    PACKAGE BODY P1 IS
                    BEGIN
                         NULL;
                    END P1;
                    PACKAGE BODY P2 IS
                    BEGIN
                         IF X /= IDENT_INT(15) OR X /= P2.X OR
                            A /= P2.X THEN
                              FAILED ("CASE B1 : DECLARATION NO " &
                                      "LONGER DIRECTLY VISIBLE");
                         END IF;
                    END P2;

               BEGIN

                    NULL;

               END CASE_B1;

     CASE_B2 : DECLARE

                    PROCEDURE PROC1 (X : STRING) IS
                    BEGIN
                         NULL;
                    END PROC1;

                    PACKAGE P1 IS
                         PROCEDURE PROC1 (X : STRING);
                    END P1;
                    PACKAGE BODY P1 IS
                         PROCEDURE PROC1 (X : STRING) IS
                         BEGIN
                              FAILED ("CASE B2 : WRONG PROCEDURE " &
                                      "DIRECTLY VISIBLE");
                         END PROC1;
                    END P1;

                    USE P1;

               BEGIN

                    PROC1 ("ABC");

               END CASE_B2;

     CASE_B3 : DECLARE

                    PROCEDURE PROC1 (X : STRING) IS
                    BEGIN
                         NULL;
                    END PROC1;

                    PACKAGE P1 IS
                         PROCEDURE PROC1 (Y : STRING);
                    END P1;
                    PACKAGE BODY P1 IS
                         PROCEDURE PROC1 (Y : STRING) IS
                         BEGIN
                              FAILED ("CASE B3 : WRONG PROCEDURE " &
                                      "DIRECTLY VISIBLE");
                         END PROC1;
                    END P1;

                    USE P1;

               BEGIN

                    PROC1 ("ABC");

               END CASE_B3;

          END CASE_B;

          COMMENT ("CASE C : IF A HOMOGRAPH FOR A POTENTIALLY "      &
                   "VISIBLE SUBPROGRAM OR OBJECT IS DECLARED AFTER " &
                   "A USE CLAUSE, THE POTENTIALLY VISIBLE ENTITY "   &
                   "IS NO LONGER VISIBLE");

CASE_C :  BEGIN

     CASE_C1 : DECLARE

                    PACKAGE P1 IS
                         PROCEDURE PROC1 (X : FLOAT);
                    END P1;

                    USE P1;

                    PACKAGE BODY P1 IS
                         PROCEDURE PROC1 (X : FLOAT) IS
                         BEGIN
                              IF X = -1.5 THEN
                                   FAILED ("CASE C1 : WRONG PROCEDURE" &
                                           " CALLED (A)");
                              ELSIF X /= 1.5 THEN
                                   FAILED ("CASE C1 : WRONG VALUE " &
                                           "PASSED (A)");
                              END IF;
                         END PROC1;
                    BEGIN
                         NULL;
                    END P1;

                    PROCEDURE PROC2 IS
                    BEGIN
                         PROC1 (1.5);
                    END PROC2;

                    PROCEDURE PROC1 (X : FLOAT) IS
                    BEGIN
                         IF X = 1.5 THEN
                              FAILED ("CASE C1 : WRONG PROCEDURE" &
                                      " CALLED (B)");
                         ELSIF X /= -1.5 THEN
                              FAILED ("CASE C1 : WRONG VALUE " &
                                      "PASSED (B)");
                         END IF;
                    END PROC1;

               BEGIN

                    PROC2;
                    PROC1 (-1.5);

               END CASE_C1;

     CASE_C2 : DECLARE

                    PACKAGE P1 IS
                         X : INTEGER := 15;
                    END P1;

                    USE P1;

                    A : INTEGER := X;

                    X : BOOLEAN := TRUE;

                    B : BOOLEAN := X;

               BEGIN

                    IF A /= IDENT_INT(15) THEN
                         FAILED ("CASE C2 : VARIABLE A DOES NOT " &
                                 "CONTAIN THE CORRECT VALUE");
                    END IF;
                    IF B /= IDENT_BOOL(TRUE) THEN
                         FAILED ("CASE C2 : VARIABLE B DOES NOT " &
                                 "CONTAIN THE CORRECT VALUE");
                    END IF;

               END CASE_C2;

          END CASE_C;

     END;

     RESULT;

END C84002A;