-- C43004A.ADA
|
-- C43004A.ADA
|
|
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- 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
|
-- 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 in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- 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
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- CHECK THAT CONSTRAINT_ERROR IS RAISED IF A VALUE FOR A
|
-- CHECK THAT CONSTRAINT_ERROR IS RAISED IF A VALUE FOR A
|
-- NON-DISCRIMINANT SCALAR COMPONENT OF AN AGGREGATE IS NOT
|
-- NON-DISCRIMINANT SCALAR COMPONENT OF AN AGGREGATE IS NOT
|
-- WITHIN THE RANGE OF THE COMPONENT'S SUBTYPE.
|
-- WITHIN THE RANGE OF THE COMPONENT'S SUBTYPE.
|
|
|
-- HISTORY:
|
-- HISTORY:
|
-- BCB 01/22/88 CREATED ORIGINAL TEST.
|
-- BCB 01/22/88 CREATED ORIGINAL TEST.
|
-- RJW 06/27/90 CORRECTED CONSTRAINTS OF TYPE DFIX.
|
-- RJW 06/27/90 CORRECTED CONSTRAINTS OF TYPE DFIX.
|
-- LDC 09/25/90 ADDED A BLOCK IN THE EXCEPTION HANDLER SO IT CAN
|
-- LDC 09/25/90 ADDED A BLOCK IN THE EXCEPTION HANDLER SO IT CAN
|
-- NOT OPTIMIZE IT AWAY, ALSO INITIALIZED EACH
|
-- NOT OPTIMIZE IT AWAY, ALSO INITIALIZED EACH
|
-- OBJECT TO VALID DATA BEFORE DOING THE INVALID,
|
-- OBJECT TO VALID DATA BEFORE DOING THE INVALID,
|
-- MADE 'IDENT_XXX' FUNCTIONS SO THE COMPILER CAN
|
-- MADE 'IDENT_XXX' FUNCTIONS SO THE COMPILER CAN
|
-- NOT JUST EVALUATE THE ASSIGNMENT AND PUT IN CODE
|
-- NOT JUST EVALUATE THE ASSIGNMENT AND PUT IN CODE
|
-- FOR A CONSTRAINT ERROR IN IS PLACE.
|
-- FOR A CONSTRAINT ERROR IN IS PLACE.
|
-- JRL 06/07/96 Changed value in aggregate in subtest 4 to value
|
-- JRL 06/07/96 Changed value in aggregate in subtest 4 to value
|
-- guaranteed to be in the base range of the type FIX.
|
-- guaranteed to be in the base range of the type FIX.
|
-- Corrected typo.
|
-- Corrected typo.
|
|
|
WITH REPORT; USE REPORT;
|
WITH REPORT; USE REPORT;
|
|
|
PROCEDURE C43004A IS
|
PROCEDURE C43004A IS
|
|
|
TYPE INT IS RANGE 1 .. 8;
|
TYPE INT IS RANGE 1 .. 8;
|
SUBTYPE SINT IS INT RANGE 2 .. 7;
|
SUBTYPE SINT IS INT RANGE 2 .. 7;
|
|
|
TYPE ENUM IS (VINCE, JOHN, TOM, PHIL, ROSA, JODIE, BRIAN, DAVE);
|
TYPE ENUM IS (VINCE, JOHN, TOM, PHIL, ROSA, JODIE, BRIAN, DAVE);
|
SUBTYPE SENUM IS ENUM RANGE JOHN .. BRIAN;
|
SUBTYPE SENUM IS ENUM RANGE JOHN .. BRIAN;
|
|
|
TYPE FL IS DIGITS 5 RANGE 0.0 .. 10.0;
|
TYPE FL IS DIGITS 5 RANGE 0.0 .. 10.0;
|
SUBTYPE SFL IS FL RANGE 1.0 .. 9.0;
|
SUBTYPE SFL IS FL RANGE 1.0 .. 9.0;
|
|
|
TYPE FIX IS DELTA 0.25 RANGE 0.0 .. 8.0;
|
TYPE FIX IS DELTA 0.25 RANGE 0.0 .. 8.0;
|
SUBTYPE SFIX IS FIX RANGE 1.0 .. 7.0;
|
SUBTYPE SFIX IS FIX RANGE 1.0 .. 7.0;
|
|
|
TYPE DINT IS NEW INTEGER RANGE 1 .. 8;
|
TYPE DINT IS NEW INTEGER RANGE 1 .. 8;
|
SUBTYPE SDINT IS DINT RANGE 2 .. 7;
|
SUBTYPE SDINT IS DINT RANGE 2 .. 7;
|
|
|
TYPE DENUM IS NEW ENUM RANGE VINCE .. DAVE;
|
TYPE DENUM IS NEW ENUM RANGE VINCE .. DAVE;
|
SUBTYPE SDENUM IS DENUM RANGE JOHN .. BRIAN;
|
SUBTYPE SDENUM IS DENUM RANGE JOHN .. BRIAN;
|
|
|
TYPE DFL IS NEW FLOAT RANGE 0.0 .. 10.0;
|
TYPE DFL IS NEW FLOAT RANGE 0.0 .. 10.0;
|
SUBTYPE SDFL IS DFL RANGE 1.0 .. 9.0;
|
SUBTYPE SDFL IS DFL RANGE 1.0 .. 9.0;
|
|
|
TYPE DFIX IS NEW FIX RANGE 0.5 .. 7.5;
|
TYPE DFIX IS NEW FIX RANGE 0.5 .. 7.5;
|
SUBTYPE SDFIX IS DFIX RANGE 1.0 .. 7.0;
|
SUBTYPE SDFIX IS DFIX RANGE 1.0 .. 7.0;
|
|
|
TYPE REC1 IS RECORD
|
TYPE REC1 IS RECORD
|
E1, E2, E3, E4, E5 : SENUM;
|
E1, E2, E3, E4, E5 : SENUM;
|
END RECORD;
|
END RECORD;
|
|
|
TYPE REC2 IS RECORD
|
TYPE REC2 IS RECORD
|
E1, E2, E3, E4, E5 : SFIX;
|
E1, E2, E3, E4, E5 : SFIX;
|
END RECORD;
|
END RECORD;
|
|
|
TYPE REC3 IS RECORD
|
TYPE REC3 IS RECORD
|
E1, E2, E3, E4, E5 : SDENUM;
|
E1, E2, E3, E4, E5 : SDENUM;
|
END RECORD;
|
END RECORD;
|
|
|
TYPE REC4 IS RECORD
|
TYPE REC4 IS RECORD
|
E1, E2, E3, E4, E5 : SDFIX;
|
E1, E2, E3, E4, E5 : SDFIX;
|
END RECORD;
|
END RECORD;
|
|
|
ARRAY_OBJ : ARRAY(1..2) OF INTEGER;
|
ARRAY_OBJ : ARRAY(1..2) OF INTEGER;
|
|
|
A : ARRAY(1..5) OF SINT;
|
A : ARRAY(1..5) OF SINT;
|
B : REC1;
|
B : REC1;
|
C : ARRAY(1..5) OF SFL;
|
C : ARRAY(1..5) OF SFL;
|
D : REC2;
|
D : REC2;
|
E : ARRAY(1..5) OF SDINT;
|
E : ARRAY(1..5) OF SDINT;
|
F : REC3;
|
F : REC3;
|
G : ARRAY(1..5) OF SDFL;
|
G : ARRAY(1..5) OF SDFL;
|
H : REC4;
|
H : REC4;
|
|
|
GENERIC
|
GENERIC
|
TYPE GENERAL_PURPOSE IS PRIVATE;
|
TYPE GENERAL_PURPOSE IS PRIVATE;
|
FUNCTION GENEQUAL(ONE, TWO : GENERAL_PURPOSE) RETURN BOOLEAN;
|
FUNCTION GENEQUAL(ONE, TWO : GENERAL_PURPOSE) RETURN BOOLEAN;
|
|
|
FUNCTION GENEQUAL(ONE, TWO : GENERAL_PURPOSE) RETURN BOOLEAN IS
|
FUNCTION GENEQUAL(ONE, TWO : GENERAL_PURPOSE) RETURN BOOLEAN IS
|
BEGIN
|
BEGIN
|
IF EQUAL(3,3) THEN
|
IF EQUAL(3,3) THEN
|
RETURN ONE = TWO;
|
RETURN ONE = TWO;
|
ELSE
|
ELSE
|
RETURN ONE /= TWO;
|
RETURN ONE /= TWO;
|
END IF;
|
END IF;
|
END GENEQUAL;
|
END GENEQUAL;
|
|
|
FUNCTION EQUAL IS NEW GENEQUAL(SENUM);
|
FUNCTION EQUAL IS NEW GENEQUAL(SENUM);
|
FUNCTION EQUAL IS NEW GENEQUAL(SFL);
|
FUNCTION EQUAL IS NEW GENEQUAL(SFL);
|
FUNCTION EQUAL IS NEW GENEQUAL(SFIX);
|
FUNCTION EQUAL IS NEW GENEQUAL(SFIX);
|
FUNCTION EQUAL IS NEW GENEQUAL(SDENUM);
|
FUNCTION EQUAL IS NEW GENEQUAL(SDENUM);
|
FUNCTION EQUAL IS NEW GENEQUAL(SDFL);
|
FUNCTION EQUAL IS NEW GENEQUAL(SDFL);
|
FUNCTION EQUAL IS NEW GENEQUAL(SDFIX);
|
FUNCTION EQUAL IS NEW GENEQUAL(SDFIX);
|
|
|
GENERIC
|
GENERIC
|
TYPE GENERAL_PURPOSE IS PRIVATE;
|
TYPE GENERAL_PURPOSE IS PRIVATE;
|
WITH FUNCTION EQUAL_GENERAL(ONE, TWO : GENERAL_PURPOSE)
|
WITH FUNCTION EQUAL_GENERAL(ONE, TWO : GENERAL_PURPOSE)
|
RETURN BOOLEAN;
|
RETURN BOOLEAN;
|
FUNCTION GEN_IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE;
|
FUNCTION GEN_IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE;
|
FUNCTION GEN_IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE IS
|
FUNCTION GEN_IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE IS
|
BEGIN
|
BEGIN
|
IF EQUAL_GENERAL (X, X) THEN -- ALWAYS EQUAL.
|
IF EQUAL_GENERAL (X, X) THEN -- ALWAYS EQUAL.
|
RETURN X; -- ALWAYS EXECUTED.
|
RETURN X; -- ALWAYS EXECUTED.
|
END IF;
|
END IF;
|
-- NEVER EXECUTED.
|
-- NEVER EXECUTED.
|
RETURN X;
|
RETURN X;
|
END GEN_IDENT;
|
END GEN_IDENT;
|
|
|
FUNCTION IDENT_FL IS NEW GEN_IDENT(FL, EQUAL);
|
FUNCTION IDENT_FL IS NEW GEN_IDENT(FL, EQUAL);
|
FUNCTION IDENT_FIX IS NEW GEN_IDENT(FIX, EQUAL);
|
FUNCTION IDENT_FIX IS NEW GEN_IDENT(FIX, EQUAL);
|
FUNCTION IDENT_DFL IS NEW GEN_IDENT(DFL, EQUAL);
|
FUNCTION IDENT_DFL IS NEW GEN_IDENT(DFL, EQUAL);
|
FUNCTION IDENT_DFIX IS NEW GEN_IDENT(DFIX, EQUAL);
|
FUNCTION IDENT_DFIX IS NEW GEN_IDENT(DFIX, EQUAL);
|
|
|
BEGIN
|
BEGIN
|
TEST ("C43004A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF A " &
|
TEST ("C43004A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF A " &
|
"VALUE FOR A NON-DISCRIMINANT SCALAR COMPONENT " &
|
"VALUE FOR A NON-DISCRIMINANT SCALAR COMPONENT " &
|
"OF AN AGGREGATE IS NOT WITHIN THE RANGE OF " &
|
"OF AN AGGREGATE IS NOT WITHIN THE RANGE OF " &
|
"THE COMPONENT'S SUBTYPE");
|
"THE COMPONENT'S SUBTYPE");
|
|
|
ARRAY_OBJ := (1, 2);
|
ARRAY_OBJ := (1, 2);
|
|
|
BEGIN
|
BEGIN
|
A := (2,3,4,5,6); -- OK
|
A := (2,3,4,5,6); -- OK
|
|
|
IF EQUAL (INTEGER (A(IDENT_INT(1))),
|
IF EQUAL (INTEGER (A(IDENT_INT(1))),
|
INTEGER (A(IDENT_INT(2)))) THEN
|
INTEGER (A(IDENT_INT(2)))) THEN
|
COMMENT ("DON'T OPTIMIZE A");
|
COMMENT ("DON'T OPTIMIZE A");
|
END IF;
|
END IF;
|
|
|
A := (SINT(IDENT_INT(1)),2,3,4,7);
|
A := (SINT(IDENT_INT(1)),2,3,4,7);
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- WITH INTEGER COMPONENTS.
|
-- WITH INTEGER COMPONENTS.
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 1");
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 1");
|
IF EQUAL (INTEGER (A(IDENT_INT(1))),
|
IF EQUAL (INTEGER (A(IDENT_INT(1))),
|
INTEGER (A(IDENT_INT(1)))) THEN
|
INTEGER (A(IDENT_INT(1)))) THEN
|
COMMENT ("DON'T OPTIMIZE A");
|
COMMENT ("DON'T OPTIMIZE A");
|
END IF;
|
END IF;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
END IF;
|
END IF;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
"WAS RAISED - 1");
|
"WAS RAISED - 1");
|
END;
|
END;
|
|
|
BEGIN
|
BEGIN
|
B := (JOHN,TOM,PHIL,ROSA,JOHN); -- OK
|
B := (JOHN,TOM,PHIL,ROSA,JOHN); -- OK
|
|
|
IF EQUAL (B.E1, B.E2) THEN
|
IF EQUAL (B.E1, B.E2) THEN
|
COMMENT ("DON'T OPTIMIZE B");
|
COMMENT ("DON'T OPTIMIZE B");
|
END IF;
|
END IF;
|
|
|
B := (ENUM'VAL(IDENT_INT(ENUM'POS(DAVE))), TOM, PHIL,
|
B := (ENUM'VAL(IDENT_INT(ENUM'POS(DAVE))), TOM, PHIL,
|
ROSA, JODIE);
|
ROSA, JODIE);
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- WITH COMPONENTS OF AN
|
-- WITH COMPONENTS OF AN
|
-- ENUMERATION TYPE.
|
-- ENUMERATION TYPE.
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 2");
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 2");
|
IF NOT EQUAL (B.E1, B.E1) THEN
|
IF NOT EQUAL (B.E1, B.E1) THEN
|
COMMENT ("DON'T OPTIMIZE B");
|
COMMENT ("DON'T OPTIMIZE B");
|
END IF;
|
END IF;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
END IF;
|
END IF;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
"WAS RAISED - 2");
|
"WAS RAISED - 2");
|
END;
|
END;
|
BEGIN
|
BEGIN
|
C := (2.0,3.0,4.0,5.0,6.0); -- OK
|
C := (2.0,3.0,4.0,5.0,6.0); -- OK
|
IF EQUAL (C(IDENT_INT(1)), C(IDENT_INT(2))) THEN
|
IF EQUAL (C(IDENT_INT(1)), C(IDENT_INT(2))) THEN
|
COMMENT ("DON'T OPTIMIZE C");
|
COMMENT ("DON'T OPTIMIZE C");
|
END IF;
|
END IF;
|
|
|
C := (IDENT_FL(1.0),2.0,3.0,4.0,IDENT_FL(10.0));
|
C := (IDENT_FL(1.0),2.0,3.0,4.0,IDENT_FL(10.0));
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- WITH FLOATING POINT COMPONENTS.
|
-- WITH FLOATING POINT COMPONENTS.
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 3");
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 3");
|
IF NOT EQUAL (C(IDENT_INT(1)), C(IDENT_INT(1))) THEN
|
IF NOT EQUAL (C(IDENT_INT(1)), C(IDENT_INT(1))) THEN
|
COMMENT ("DON'T OPTIMIZE C");
|
COMMENT ("DON'T OPTIMIZE C");
|
END IF;
|
END IF;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
END IF;
|
END IF;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
"WAS RAISED - 3");
|
"WAS RAISED - 3");
|
END;
|
END;
|
|
|
BEGIN
|
BEGIN
|
D := (2.2,3.3,4.4,5.5,6.6); -- OK
|
D := (2.2,3.3,4.4,5.5,6.6); -- OK
|
IF EQUAL (D.E1, D.E5) THEN
|
IF EQUAL (D.E1, D.E5) THEN
|
COMMENT ("DON'T OPTIMIZE D");
|
COMMENT ("DON'T OPTIMIZE D");
|
END IF;
|
END IF;
|
|
|
D := (IDENT_FIX(1.0),2.1,3.3,4.4,IDENT_FIX(7.75));
|
D := (IDENT_FIX(1.0),2.1,3.3,4.4,IDENT_FIX(7.75));
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- WITH FIXED POINT COMPONENTS.
|
-- WITH FIXED POINT COMPONENTS.
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 4");
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 4");
|
IF NOT EQUAL (D.E5, D.E5) THEN
|
IF NOT EQUAL (D.E5, D.E5) THEN
|
COMMENT ("DON'T OPTIMIZE D");
|
COMMENT ("DON'T OPTIMIZE D");
|
END IF;
|
END IF;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
END IF;
|
END IF;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
"WAS RAISED - 4");
|
"WAS RAISED - 4");
|
END;
|
END;
|
|
|
BEGIN
|
BEGIN
|
E := (2,3,4,5,6); -- OK
|
E := (2,3,4,5,6); -- OK
|
IF EQUAL (INTEGER (E(IDENT_INT(1))),
|
IF EQUAL (INTEGER (E(IDENT_INT(1))),
|
INTEGER (E(IDENT_INT(2)))) THEN
|
INTEGER (E(IDENT_INT(2)))) THEN
|
COMMENT ("DON'T OPTIMIZE E");
|
COMMENT ("DON'T OPTIMIZE E");
|
END IF;
|
END IF;
|
|
|
E := (SDINT(IDENT_INT(1)),2,3,4,7);
|
E := (SDINT(IDENT_INT(1)),2,3,4,7);
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- WITH DERIVED INTEGER COMPONENTS.
|
-- WITH DERIVED INTEGER COMPONENTS.
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 5");
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 5");
|
IF NOT EQUAL (INTEGER (E(IDENT_INT(1))),
|
IF NOT EQUAL (INTEGER (E(IDENT_INT(1))),
|
INTEGER (E(IDENT_INT(1)))) THEN
|
INTEGER (E(IDENT_INT(1)))) THEN
|
COMMENT ("DON'T OPTIMIZE E");
|
COMMENT ("DON'T OPTIMIZE E");
|
END IF;
|
END IF;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
END IF;
|
END IF;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
"WAS RAISED - 5");
|
"WAS RAISED - 5");
|
END;
|
END;
|
|
|
BEGIN
|
BEGIN
|
F := (JOHN,TOM,PHIL,ROSA,JOHN); -- OK
|
F := (JOHN,TOM,PHIL,ROSA,JOHN); -- OK
|
IF EQUAL (F.E1, F.E2) THEN
|
IF EQUAL (F.E1, F.E2) THEN
|
COMMENT ("DON'T OPTIMIZE F");
|
COMMENT ("DON'T OPTIMIZE F");
|
END IF;
|
END IF;
|
|
|
F := (DENUM'VAL(IDENT_INT(DENUM'POS(VINCE))), TOM, PHIL,
|
F := (DENUM'VAL(IDENT_INT(DENUM'POS(VINCE))), TOM, PHIL,
|
ROSA, JODIE);
|
ROSA, JODIE);
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- WITH COMPONENTS OF A DERIVED
|
-- WITH COMPONENTS OF A DERIVED
|
-- ENUMERATION TYPE.
|
-- ENUMERATION TYPE.
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 6");
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 6");
|
IF NOT EQUAL (F.E1, F.E1) THEN
|
IF NOT EQUAL (F.E1, F.E1) THEN
|
COMMENT ("DON'T OPTIMIZE F");
|
COMMENT ("DON'T OPTIMIZE F");
|
END IF;
|
END IF;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
END IF;
|
END IF;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
"WAS RAISED - 6");
|
"WAS RAISED - 6");
|
END;
|
END;
|
|
|
BEGIN
|
BEGIN
|
G := (2.0,3.0,4.0,5.0,6.0); -- OK
|
G := (2.0,3.0,4.0,5.0,6.0); -- OK
|
IF EQUAL (G(IDENT_INT(1)), G(IDENT_INT(2))) THEN
|
IF EQUAL (G(IDENT_INT(1)), G(IDENT_INT(2))) THEN
|
COMMENT ("DON'T OPTIMIZE G");
|
COMMENT ("DON'T OPTIMIZE G");
|
END IF;
|
END IF;
|
|
|
G := (IDENT_DFL(1.0),2.0,3.0,4.0,IDENT_DFL(10.0));
|
G := (IDENT_DFL(1.0),2.0,3.0,4.0,IDENT_DFL(10.0));
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- WITH DERIVED FLOATING POINT
|
-- WITH DERIVED FLOATING POINT
|
-- COMPONENTS.
|
-- COMPONENTS.
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 7");
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 7");
|
IF NOT EQUAL (G(IDENT_INT(1)), G(IDENT_INT(1))) THEN
|
IF NOT EQUAL (G(IDENT_INT(1)), G(IDENT_INT(1))) THEN
|
COMMENT ("DON'T OPTIMIZE G");
|
COMMENT ("DON'T OPTIMIZE G");
|
END IF;
|
END IF;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
END IF;
|
END IF;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
"WAS RAISED - 7");
|
"WAS RAISED - 7");
|
END;
|
END;
|
|
|
BEGIN
|
BEGIN
|
H := (2.2,3.3,4.4,5.5,6.6); -- OK
|
H := (2.2,3.3,4.4,5.5,6.6); -- OK
|
IF EQUAL (H.E1, H.E2) THEN
|
IF EQUAL (H.E1, H.E2) THEN
|
COMMENT ("DON'T OPTIMIZE H");
|
COMMENT ("DON'T OPTIMIZE H");
|
END IF;
|
END IF;
|
|
|
H := (IDENT_DFIX(2.0),2.5,3.5,4.3,IDENT_DFIX(7.4));
|
H := (IDENT_DFIX(2.0),2.5,3.5,4.3,IDENT_DFIX(7.4));
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- CONSTRAINT_ERROR BY AGGREGATE
|
-- WITH DERIVED FIXED POINT
|
-- WITH DERIVED FIXED POINT
|
-- COMPONENTS.
|
-- COMPONENTS.
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 8");
|
FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 8");
|
IF EQUAL (H.E1, H.E5) THEN
|
IF EQUAL (H.E1, H.E5) THEN
|
COMMENT ("DON'T OPTIMIZE H");
|
COMMENT ("DON'T OPTIMIZE H");
|
END IF;
|
END IF;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
ARRAY_OBJ(IDENT_INT(2))) THEN
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
|
END IF;
|
END IF;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
|
"WAS RAISED - 8");
|
"WAS RAISED - 8");
|
END;
|
END;
|
|
|
|
|
RESULT;
|
RESULT;
|
END C43004A;
|
END C43004A;
|
|
|