-- C35703A.ADA
|
-- C35703A.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.
|
--*
|
--*
|
-- CHECK THAT 'FIRST AND 'LAST EXIST AND CAN BE ASSIGNED. CHECK THAT
|
-- CHECK THAT 'FIRST AND 'LAST EXIST AND CAN BE ASSIGNED. CHECK THAT
|
-- 'FIRST IS LESS THAN OR EQUAL TO 'LAST.
|
-- 'FIRST IS LESS THAN OR EQUAL TO 'LAST.
|
|
|
-- BAW 5 SEPT 80
|
-- BAW 5 SEPT 80
|
-- R.WILLIAMS 8/21/86 ADDED A TYPE DECLARED WITHOUT A RANGE
|
-- R.WILLIAMS 8/21/86 ADDED A TYPE DECLARED WITHOUT A RANGE
|
-- CONSTRAINT. RENAMED TO -B. ADDED EXCEPTION
|
-- CONSTRAINT. RENAMED TO -B. ADDED EXCEPTION
|
-- HANDLERS.
|
-- HANDLERS.
|
-- GMT 6/29/87 MOVED THE CALL TO REPORT.TEST INTO A NEWLY
|
-- GMT 6/29/87 MOVED THE CALL TO REPORT.TEST INTO A NEWLY
|
-- CREATED PACKAGE NAMED SHOW_TEST_HEADER.
|
-- CREATED PACKAGE NAMED SHOW_TEST_HEADER.
|
|
|
|
|
WITH REPORT; USE REPORT;
|
WITH REPORT; USE REPORT;
|
PROCEDURE C35703A IS
|
PROCEDURE C35703A IS
|
|
|
TYPE REAL1 IS DIGITS 2 RANGE 0.25..0.5;
|
TYPE REAL1 IS DIGITS 2 RANGE 0.25..0.5;
|
TYPE REAL2 IS DIGITS 3;
|
TYPE REAL2 IS DIGITS 3;
|
|
|
PACKAGE SHOW_TEST_HEADER IS
|
PACKAGE SHOW_TEST_HEADER IS
|
-- PURPOSE OF THIS PACKAGE:
|
-- PURPOSE OF THIS PACKAGE:
|
-- WE WANT THE TEST HEADER INFORMATION TO BE
|
-- WE WANT THE TEST HEADER INFORMATION TO BE
|
-- PRINTED BEFORE ANY OF THE PASS/FAIL MESSAGES.
|
-- PRINTED BEFORE ANY OF THE PASS/FAIL MESSAGES.
|
END SHOW_TEST_HEADER;
|
END SHOW_TEST_HEADER;
|
|
|
PACKAGE BODY SHOW_TEST_HEADER IS
|
PACKAGE BODY SHOW_TEST_HEADER IS
|
BEGIN
|
BEGIN
|
TEST( "C35703A",
|
TEST( "C35703A",
|
"CHECK THAT FIRST AND LAST CAN BE ASSIGNED " &
|
"CHECK THAT FIRST AND LAST CAN BE ASSIGNED " &
|
"AND THAT FIRST <= LAST" );
|
"AND THAT FIRST <= LAST" );
|
END SHOW_TEST_HEADER;
|
END SHOW_TEST_HEADER;
|
|
|
PACKAGE XPKG IS
|
PACKAGE XPKG IS
|
X : REAL1;
|
X : REAL1;
|
END XPKG;
|
END XPKG;
|
|
|
PACKAGE BODY XPKG IS
|
PACKAGE BODY XPKG IS
|
BEGIN
|
BEGIN
|
X := REAL1'FIRST;
|
X := REAL1'FIRST;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
|
FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
|
"REAL1'FIRST" );
|
"REAL1'FIRST" );
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
|
FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
|
"REAL1'FIRST" );
|
"REAL1'FIRST" );
|
END XPKG;
|
END XPKG;
|
|
|
PACKAGE YPKG IS
|
PACKAGE YPKG IS
|
Y : REAL1;
|
Y : REAL1;
|
END YPKG;
|
END YPKG;
|
|
|
PACKAGE BODY YPKG IS
|
PACKAGE BODY YPKG IS
|
BEGIN
|
BEGIN
|
Y := REAL1'LAST;
|
Y := REAL1'LAST;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
|
FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
|
"REAL1'LAST" );
|
"REAL1'LAST" );
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
|
FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
|
"REAL1'LAST" );
|
"REAL1'LAST" );
|
END YPKG;
|
END YPKG;
|
|
|
PACKAGE APKG IS
|
PACKAGE APKG IS
|
A : REAL2;
|
A : REAL2;
|
END APKG;
|
END APKG;
|
|
|
PACKAGE BODY APKG IS
|
PACKAGE BODY APKG IS
|
BEGIN
|
BEGIN
|
A := REAL2'FIRST;
|
A := REAL2'FIRST;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
|
FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
|
"REAL2'FIRST" );
|
"REAL2'FIRST" );
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
|
FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
|
"REAL2'FIRST" );
|
"REAL2'FIRST" );
|
END APKG;
|
END APKG;
|
|
|
PACKAGE BPKG IS
|
PACKAGE BPKG IS
|
B : REAL2;
|
B : REAL2;
|
END BPKG;
|
END BPKG;
|
|
|
PACKAGE BODY BPKG IS
|
PACKAGE BODY BPKG IS
|
BEGIN
|
BEGIN
|
B := REAL2'LAST;
|
B := REAL2'LAST;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
|
FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
|
"REAL2'LAST" );
|
"REAL2'LAST" );
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
|
FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
|
"REAL2'LAST" );
|
"REAL2'LAST" );
|
END BPKG;
|
END BPKG;
|
|
|
|
|
BEGIN
|
BEGIN
|
|
|
DECLARE
|
DECLARE
|
USE XPKG;
|
USE XPKG;
|
USE YPKG;
|
USE YPKG;
|
BEGIN
|
BEGIN
|
IF X > Y THEN
|
IF X > Y THEN
|
FAILED ( "REAL1'FIRST IS GREATER THAN REAL1'LAST" );
|
FAILED ( "REAL1'FIRST IS GREATER THAN REAL1'LAST" );
|
END IF;
|
END IF;
|
END;
|
END;
|
|
|
DECLARE
|
DECLARE
|
USE APKG;
|
USE APKG;
|
USE BPKG;
|
USE BPKG;
|
BEGIN
|
BEGIN
|
IF A > B THEN
|
IF A > B THEN
|
FAILED ( "REAL2'FIRST IS GREATER THEN REAL2'LAST" );
|
FAILED ( "REAL2'FIRST IS GREATER THEN REAL2'LAST" );
|
END IF;
|
END IF;
|
END;
|
END;
|
|
|
RESULT;
|
RESULT;
|
|
|
END C35703A;
|
END C35703A;
|
|
|