path: root/gcc/testsuite/ada/acats/tests/c8/c83030c.ada

-- C83030C.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.
--*
-- OBJECTIVE:
--     CHECK THAT WITHIN A GENERIC SUBPROGRAM BODY COMPILED AS A SUBUNIT
--     IN THE SAME COMPILATION, NON-HOMOGRAPH SUBPROGRAMS DECLARED
--     OUTSIDE THE GENERIC UNIT, AND HAVING THE SAME IDENTIFIER, ARE NOT
--     HIDDEN.

-- HISTORY:
--     JET 10/17/88  CREATED ORIGINAL TEST.
--     BCB 10/03/90  ADDED "PRAGMA ELABORATE (REPORT);".

WITH REPORT; USE REPORT;
PRAGMA ELABORATE (REPORT);
PACKAGE C83030C_DECL1 IS
     GLOBAL : INTEGER := IDENT_INT(INTEGER'FIRST);
     SWITCH : BOOLEAN := TRUE;

     PROCEDURE C83030C_PROC1;
     PROCEDURE C83030C_PROC1 (X : INTEGER);
     PROCEDURE C83030C_PROC2;
     PROCEDURE C83030C_PROC2 (X : INTEGER);
     FUNCTION C83030C_FUNC3 RETURN INTEGER;
     FUNCTION C83030C_FUNC3 RETURN BOOLEAN;
     FUNCTION C83030C_FUNC3 (X : INTEGER) RETURN INTEGER;
     FUNCTION C83030C_FUNC4 RETURN INTEGER;
     FUNCTION C83030C_FUNC4 RETURN BOOLEAN;
END C83030C_DECL1;

WITH REPORT; USE REPORT;
WITH C83030C_DECL1; USE C83030C_DECL1;
PACKAGE C83030C_DECL2 IS
     GENERIC
     PROCEDURE C83030C_PROC1;

     GENERIC
          TYPE T IS (<>);
     PROCEDURE C83030C_PROC2 (X : T);

     GENERIC
     FUNCTION C83030C_FUNC3 RETURN INTEGER;

     GENERIC
          TYPE T IS (<>);
     FUNCTION C83030C_FUNC4 RETURN T;
END C83030C_DECL2;

WITH REPORT; USE REPORT;
PACKAGE BODY C83030C_DECL1 IS
     PROCEDURE C83030C_PROC1 IS
     BEGIN
          GLOBAL := IDENT_INT(1);
     END C83030C_PROC1;

     PROCEDURE C83030C_PROC1 (X : INTEGER) IS
     BEGIN
          GLOBAL := IDENT_INT(X);
     END C83030C_PROC1;

     PROCEDURE C83030C_PROC2 IS
     BEGIN
          GLOBAL := IDENT_INT(1);
     END C83030C_PROC2;

     PROCEDURE C83030C_PROC2 (X : INTEGER) IS
     BEGIN
          GLOBAL := IDENT_INT(X);
     END C83030C_PROC2;

     FUNCTION C83030C_FUNC3 RETURN INTEGER IS
     BEGIN
          RETURN IDENT_INT(1);
     END C83030C_FUNC3;

     FUNCTION C83030C_FUNC3 RETURN BOOLEAN IS
     BEGIN
          RETURN IDENT_BOOL(FALSE);
     END C83030C_FUNC3;

     FUNCTION C83030C_FUNC3 (X : INTEGER) RETURN INTEGER IS
     BEGIN
          RETURN IDENT_INT(X);
     END C83030C_FUNC3;

     FUNCTION C83030C_FUNC4 RETURN INTEGER IS
     BEGIN
          RETURN IDENT_INT(1);
     END C83030C_FUNC4;

     FUNCTION C83030C_FUNC4 RETURN BOOLEAN IS
     BEGIN
          RETURN IDENT_BOOL(FALSE);
     END C83030C_FUNC4;
END C83030C_DECL1;

WITH REPORT; USE REPORT;
WITH C83030C_DECL1; USE C83030C_DECL1;
PACKAGE BODY C83030C_DECL2 IS
     PROCEDURE C83030C_PROC1 IS SEPARATE;
     PROCEDURE C83030C_PROC2 (X : T) IS SEPARATE;
     FUNCTION C83030C_FUNC3 RETURN INTEGER IS SEPARATE;
     FUNCTION C83030C_FUNC4 RETURN T IS SEPARATE;
END C83030C_DECL2;

SEPARATE (C83030C_DECL2)
PROCEDURE C83030C_PROC1 IS
     A : INTEGER := IDENT_INT(2);
BEGIN
     IF SWITCH THEN
          SWITCH := FALSE;
          C83030C_PROC1;
          IF GLOBAL /= IDENT_INT(3) THEN
               FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 1");
          END IF;
     END IF;
     C83030C_PROC1(A);
     IF GLOBAL /= IDENT_INT(2) THEN
          FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 2");
     END IF;
     GLOBAL := IDENT_INT(3);
END C83030C_PROC1;

SEPARATE (C83030C_DECL2)
PROCEDURE C83030C_PROC2 (X : T) IS
     A : T := T'FIRST;
BEGIN
     IF SWITCH THEN
          SWITCH := FALSE;
          C83030C_PROC2 (X);
          IF GLOBAL /= IDENT_INT(2) THEN
               FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 20");
          END IF;
          GLOBAL := IDENT_INT(3);
     ELSE
          GLOBAL := IDENT_INT(2);
     END IF;
END C83030C_PROC2;

SEPARATE (C83030C_DECL2)
FUNCTION C83030C_FUNC3 RETURN INTEGER IS
     A : INTEGER := INTEGER'LAST;
BEGIN
     IF SWITCH THEN
          SWITCH := FALSE;
          IF C83030C_FUNC3 /= IDENT_INT(3) THEN
               FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 30");
          END IF;
     END IF;
     IF C83030C_FUNC3(A) /= IDENT_INT(INTEGER'LAST) THEN
          FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 31");
     END IF;
     IF C83030C_FUNC3 THEN
          FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 32");
     END IF;
     RETURN IDENT_INT(3);
END C83030C_FUNC3;

SEPARATE (C83030C_DECL2)
FUNCTION C83030C_FUNC4 RETURN T IS
     A : T := T'LAST;
BEGIN
     IF SWITCH THEN
          SWITCH := FALSE;
          IF C83030C_FUNC4 /= T'LAST THEN
               FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 40");
          END IF;
          RETURN T'FIRST;
     ELSE
          IF C83030C_FUNC4 THEN
               FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 41");
          END IF;
          RETURN T'LAST;
     END IF;
END C83030C_FUNC4;

WITH REPORT; USE REPORT;
WITH C83030C_DECL1, C83030C_DECL2; USE C83030C_DECL1, C83030C_DECL2;
PROCEDURE C83030C IS
BEGIN
     TEST ("C83030C", "CHECK THAT WITHIN A GENERIC SUBPROGRAM BODY " &
                      "COMPILED AS A SUBUNIT IN THE SAME COMPILATION," &
                      " NON-HOMOGRAPH SUBPROGRAMS DECLARED OUTSIDE " &
                      "THE GENERIC UNIT, AND HAVING THE SAME " &
                      "IDENTIFIER, ARE NOT HIDDEN");

     ONE:
     DECLARE
          PROCEDURE PROC1 IS NEW C83030C_DECL2.C83030C_PROC1;
     BEGIN
          IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
               FAILED ("INCORRECT VALUE FOR START OF TEST ONE");
          END IF;
          PROC1;
          IF GLOBAL /= IDENT_INT(3) THEN
               FAILED ("INCORRECT VALUE FOR END OF TEST ONE");
          END IF;

          GLOBAL := IDENT_INT(INTEGER'FIRST);
          SWITCH := TRUE;
     END ONE;

     TWO:
     DECLARE
          PROCEDURE PROC2 IS NEW C83030C_DECL2.C83030C_PROC2(INTEGER);
     BEGIN
          IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
               FAILED ("INCORRECT VALUE FOR START OF TEST TWO");
          END IF;
          PROC2 (1);
          IF GLOBAL /= IDENT_INT(3) THEN
               FAILED ("INCORRECT VALUE FOR END OF TEST TWO");
          END IF;

          SWITCH := TRUE;
     END TWO;

     THREE:
     DECLARE
          FUNCTION FUNC3 IS NEW C83030C_DECL2.C83030C_FUNC3;
     BEGIN
          IF FUNC3 /= IDENT_INT(3) THEN
               FAILED ("INCORRECT VALUE FOR END OF TEST THREE");
          END IF;

          SWITCH := TRUE;
     END THREE;

     FOUR:
     DECLARE
          FUNCTION FUNC4 IS NEW C83030C_DECL2.C83030C_FUNC4 (INTEGER);
     BEGIN
          IF FUNC4 /= IDENT_INT(INTEGER'FIRST) THEN
               FAILED ("INCORRECT VALUE FOR END OF TEST FOUR");
          END IF;

          GLOBAL := INTEGER'FIRST;
          SWITCH := TRUE;
     END FOUR;

     RESULT;
END C83030C;