URL
https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk
Subversion Repositories openrisc_2011-10-31
[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c32113a.ada] - Rev 384
Compare with Previous | Blame | View Log
-- C32113A.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 WHEN A VARIABLE OR CONSTANT HAVING A CONSTRAINED TYPE -- WITH DISCRIMINANTS IS DECLARED WITH AN INITIAL VALUE, -- CONSTRAINT_ERROR IS RAISED IF THE CORRESPONDING DISCRIMINANTS OF -- THE INITIAL VALUE AND THE SUBTYPE DO NOT HAVE THE SAME VALUE. -- HISTORY: -- RJW 07/20/86 -- DWC 06/22/87 ADDED SUBTYPE PRIVAS. ADDED CODE TO PREVENT DEAD -- VARIABLE OPTIMIZATION. WITH REPORT; USE REPORT; PROCEDURE C32113A IS PACKAGE PKG IS TYPE PRIVA (D : INTEGER := 0) IS PRIVATE; SUBTYPE PRIVAS IS PRIVA (IDENT_INT (1)); PRA1 : CONSTANT PRIVAS; TYPE PRIVB (D1, D2 : INTEGER) IS PRIVATE; PRB12 : CONSTANT PRIVB; PRIVATE TYPE PRIVA (D : INTEGER := 0) IS RECORD NULL; END RECORD; TYPE PRIVB (D1, D2 : INTEGER) IS RECORD NULL; END RECORD; PRA1 : CONSTANT PRIVAS := (D => (IDENT_INT (1))); PRB12 : CONSTANT PRIVB := (IDENT_INT (1), IDENT_INT (2)); END PKG; USE PKG; TYPE RECA (D : INTEGER := 0) IS RECORD NULL; END RECORD; TYPE RECB (D1, D2 : INTEGER) IS RECORD NULL; END RECORD; RA1 : CONSTANT RECA (IDENT_INT (1)) := (D => (IDENT_INT (1))); RB12 : CONSTANT RECB := (IDENT_INT (1), IDENT_INT (2)); BEGIN TEST ("C32113A", "CHECK THAT WHEN A VARIABLE OR CONSTANT " & "HAVING A CONSTRAINED TYPE IS DECLARED WITH " & "AN INITIAL VALUE, CONSTRAINT_ERROR IS " & "RAISED IF THE CORRESPONDING DISCRIMINANTS " & "OF THE INITIAL VALUE AND THE SUBTYPE DO " & "NOT HAVE THE SAME VALUE" ); BEGIN DECLARE PR1 : CONSTANT PRIVA (IDENT_INT (0)) := PRA1; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'PR1'" ); IF PR1 = PRA1 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'PR1'" ); END; BEGIN DECLARE PR2 : CONSTANT PRIVA (IDENT_INT (2)) := PRA1; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'PR2'" ); IF PR2 = PRA1 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'PR2'" ); END; BEGIN DECLARE PR3 : PRIVA (IDENT_INT (0)) := PRA1; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'PR3'" ); IF PR3 = PRA1 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'PR3'" ); END; BEGIN DECLARE PR4 : PRIVA (IDENT_INT (2)) := PRA1; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'PR4'" ); IF PR4 = PRA1 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'PR4'" ); END; BEGIN DECLARE SUBTYPE SPRIVA IS PRIVA (IDENT_INT (-1)); PR5 : CONSTANT SPRIVA := PRA1; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'PR5'" ); IF PR5 = PRA1 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'PR5'" ); END; BEGIN DECLARE SUBTYPE SPRIVA IS PRIVA (IDENT_INT (3)); PR6 : SPRIVA := PRA1; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'PR6'" ); IF PR6 = PRA1 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'PR6'" ); END; BEGIN DECLARE PR7 : CONSTANT PRIVB (IDENT_INT (1), IDENT_INT (1)) := PRB12; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'PR7'" ); IF PR7 = PRB12 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'PR7'" ); END; BEGIN DECLARE PR8 : CONSTANT PRIVB (IDENT_INT (2), IDENT_INT (2)) := PRB12; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'PR8'" ); IF PR8 = PRB12 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'PR8'" ); END; BEGIN DECLARE PR9 : PRIVB (IDENT_INT (1), IDENT_INT (1)) := PRB12; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'PR9'" ); IF PR9 = PRB12 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'PR9'" ); END; BEGIN DECLARE PR10 : PRIVB (IDENT_INT (2), IDENT_INT (2)) := PRB12; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'PR10'" ); IF PR10 = PRB12 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'PR10'" ); END; BEGIN DECLARE SUBTYPE SPRIVB IS PRIVB (IDENT_INT (-1), IDENT_INT (-2)); PR11 : CONSTANT SPRIVB := PRB12; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'PR11'" ); IF PR11 = PRB12 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'PR11'" ); END; BEGIN DECLARE SUBTYPE SPRIVB IS PRIVB (IDENT_INT (2), IDENT_INT (1)); PR12 : SPRIVB := PRB12; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'PR12'" ); IF PR12 = PRB12 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'PR12'" ); END; BEGIN DECLARE R1 : CONSTANT RECA (IDENT_INT (0)) := RA1; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'R1'" ); IF R1 = RA1 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'R1'" ); END; BEGIN DECLARE R2 : CONSTANT RECA (IDENT_INT (2)) := RA1; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'R2'" ); IF R2 = RA1 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'R2'" ); END; BEGIN DECLARE R3 : RECA (IDENT_INT (0)) := RA1; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'R3'" ); IF R3 = RA1 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'R3'" ); END; BEGIN DECLARE R4 : RECA (IDENT_INT (2)) := RA1; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'R4'" ); IF R4 = RA1 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'R4'" ); END; BEGIN DECLARE SUBTYPE SRECA IS RECA (IDENT_INT (-1)); R5 : CONSTANT SRECA := RA1; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'R5'" ); IF R5 = RA1 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'R5'" ); END; BEGIN DECLARE SUBTYPE SRECA IS RECA (IDENT_INT (3)); R6 : SRECA := RA1; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'R6'" ); IF R6 = RA1 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'R6'" ); END; BEGIN DECLARE R7 : CONSTANT RECB (IDENT_INT (1), IDENT_INT (1)) := RB12; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'R7'" ); IF R7 = RB12 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'R7'" ); END; BEGIN DECLARE R8 : CONSTANT RECB (IDENT_INT (2), IDENT_INT (2)) := RB12; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'R8'" ); IF R8 = RB12 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'R8'" ); END; BEGIN DECLARE R9 : RECB (IDENT_INT (1), IDENT_INT (1)) := RB12; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'R9'" ); IF R9 = RB12 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'R9'" ); END; BEGIN DECLARE R10 : RECB (IDENT_INT (2), IDENT_INT (2)) := RB12; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'R10'" ); IF R10 = RB12 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'R10'" ); END; BEGIN DECLARE SUBTYPE SRECB IS RECB (IDENT_INT (-1), IDENT_INT (-2)); R11 : CONSTANT SRECB := RB12; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'R11'" ); IF R11 = RB12 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF CONSTANT 'R11'" ); END; BEGIN DECLARE SUBTYPE SRECB IS RECB (IDENT_INT (2), IDENT_INT (1)); R12 : SRECB := RB12; BEGIN FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'R12'" ); IF R12 = RB12 THEN COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); END IF; END; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & "OF VARIABLE 'R12'" ); END; RESULT; END C32113A;