diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cc/cc1227a.ada')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cc/cc1227a.ada | 289 |
1 files changed, 289 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cc/cc1227a.ada b/gcc/testsuite/ada/acats/tests/cc/cc1227a.ada new file mode 100644 index 000000000..39b453287 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cc/cc1227a.ada @@ -0,0 +1,289 @@ +-- CC1227A.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, WHEN DERIVING FROM A FORMAL TYPE, THAT ALL THE PREDEFINED +-- OPERATIONS ASSOCIATED WITH THE CLASS OF THE FORMAL TYPE ARE +-- DECLARED FOR THE DERIVED TYPE. + +-- HISTORY: +-- BCB 04/04/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SYSTEM; USE SYSTEM; + +PROCEDURE CC1227A IS + + GENERIC + TYPE FORM IS RANGE <>; + PACKAGE P IS + TYPE DER_FORM IS NEW FORM; + FUNCTION IDENT_DER(X : DER_FORM) RETURN DER_FORM; + FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS; + END P; + + PACKAGE BODY P IS + DER_VAR : DER_FORM; + DER_FORM_BASE_FIRST : DER_FORM; + DER_FORM_FIRST : DER_FORM; + DER_FORM_LAST : DER_FORM; + DER_FORM_SIZE : DER_FORM; + DER_FORM_WIDTH : DER_FORM; + DER_FORM_POS : DER_FORM; + DER_FORM_VAL : DER_FORM; + DER_FORM_SUCC : DER_FORM; + DER_FORM_PRED : DER_FORM; + DER_FORM_IMAGE : STRING(1..5); + DER_FORM_VALUE : DER_FORM; + DER_VAR_SIZE : DER_FORM; + DER_VAR_ADDRESS : ADDRESS; + DER_EQUAL, DER_UNEQUAL : DER_FORM; + DER_GREATER : DER_FORM; + DER_MOD, DER_REM : DER_FORM; + DER_ABS, DER_EXP : DER_FORM; + INT : INTEGER := 5; + FUNCTION IDENT_DER(X : DER_FORM) RETURN DER_FORM IS + BEGIN + IF EQUAL(3,3) THEN + RETURN X; + END IF; + RETURN 0; + END IDENT_DER; + FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS IS + X : DER_FORM; + BEGIN + IF EQUAL(3,3) THEN + RETURN Y; + END IF; + RETURN X'ADDRESS; + END IDENT_ADR; + BEGIN + TEST ("CC1227A", "CHECK, WHEN DERIVING FROM A FORMAL TYPE, " & + "THAT ALL THE PREDEFINED OPERATIONS " & + "ASSOCIATED WITH THE CLASS OF THE FORMAL " & + "TYPE ARE DECLARED FOR THE DERIVED TYPE"); + + DER_VAR := IDENT_DER(1); + + IF DER_VAR /= 1 THEN + FAILED ("IMPROPER VALUE FROM ASSIGNMENT OPERATION"); + END IF; + + IF DER_VAR NOT IN DER_FORM THEN + FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST"); + END IF; + + DER_VAR := DER_FORM'(2); + + IF DER_VAR /= IDENT_DER(2) THEN + FAILED ("IMPROPER RESULT FROM QUALIFICATION"); + END IF; + + DER_VAR := DER_FORM(INT); + + IF DER_VAR /= IDENT_DER(5) THEN + FAILED ("IMPROPER RESULT FROM EXPLICIT CONVERSION - " & + "INTEGER"); + END IF; + + DER_VAR := DER_FORM(3.0); + + IF DER_VAR /= IDENT_DER(3) THEN + FAILED ("IMPROPER RESULT FROM EXPLICIT CONVERSION - " & + "FLOAT"); + END IF; + + DER_VAR := 1_000; + + IF DER_VAR /= IDENT_DER(1000) THEN + FAILED ("IMPROPER RESULT FROM IMPLICIT CONVERSION"); + END IF; + + DER_FORM_BASE_FIRST := DER_FORM'BASE'FIRST; + + DER_FORM_FIRST := DER_FORM'FIRST; + + IF DER_FORM_BASE_FIRST /= IDENT_DER(DER_FORM_FIRST) THEN + FAILED ("IMPROPER VALUE FOR DER_FORM'BASE'FIRST"); + END IF; + + IF DER_FORM_FIRST /= IDENT_DER(DER_FORM'FIRST) THEN + FAILED ("IMPROPER VALUE FOR DER_FORM'FIRST"); + END IF; + + DER_FORM_LAST := DER_FORM'LAST; + + IF DER_FORM_LAST /= IDENT_DER(DER_FORM'LAST) THEN + FAILED ("IMPROPER VALUE FOR DER_FORM'LAST"); + END IF; + + DER_FORM_SIZE := DER_FORM(DER_FORM'SIZE); + + IF DER_FORM_SIZE /= IDENT_DER(DER_FORM(DER_FORM'SIZE)) THEN + FAILED ("IMPROPER VALUE FOR DER_FORM'SIZE"); + END IF; + + DER_FORM_WIDTH := DER_FORM(DER_FORM'WIDTH); + + IF DER_FORM_WIDTH /= IDENT_DER(DER_FORM(DER_FORM'WIDTH)) THEN + FAILED ("IMPROPER VALUE FOR DER_FORM'WIDTH"); + END IF; + + DER_FORM_POS := DER_FORM(DER_FORM'POS(DER_VAR)); + + IF DER_FORM_POS /= IDENT_DER(DER_FORM(DER_FORM'POS(DER_VAR))) + THEN FAILED ("IMPROPER VALUE FOR DER_FORM'POS(DER_VAR)"); + END IF; + + DER_FORM_VAL := DER_FORM'VAL(DER_VAR); + + IF DER_FORM_VAL /= IDENT_DER(DER_FORM'VAL(DER_VAR)) THEN + FAILED ("IMPROPER VALUE FOR DER_FORM'VAL(DER_VAR)"); + END IF; + + DER_FORM_SUCC := DER_FORM'SUCC(DER_VAR); + + IF DER_FORM_SUCC /= IDENT_DER(DER_FORM'SUCC(DER_VAR)) THEN + FAILED ("IMPROPER VALUE FOR DER_FORM'SUCC(DER_VAR)"); + END IF; + + DER_FORM_PRED := DER_FORM'PRED(DER_VAR); + + IF DER_FORM_PRED /= IDENT_DER(DER_FORM'PRED(DER_VAR)) THEN + FAILED ("IMPROPER VALUE FOR DER_FORM'PRED(DER_VAR)"); + END IF; + + DER_FORM_IMAGE := DER_FORM'IMAGE(DER_VAR); + + IF DER_FORM_IMAGE(2..5) /= "1000" THEN + FAILED ("IMPROPER VALUE FOR DER_FORM'IMAGE(DER_VAR)"); + END IF; + + DER_FORM_VALUE := DER_FORM'VALUE(DER_FORM_IMAGE); + + IF DER_FORM_VALUE /= IDENT_DER(1000) THEN + FAILED ("IMPROPER VALUE FOR DER_FORM'VALUE" & + "(DER_FORM_IMAGE)"); + END IF; + + DER_VAR_SIZE := DER_FORM(DER_VAR'SIZE); + + IF DER_VAR_SIZE /= IDENT_DER(DER_FORM(DER_VAR'SIZE)) THEN + FAILED ("IMPROPER VALUE FOR DER_VAR'SIZE"); + END IF; + + DER_VAR_ADDRESS := DER_VAR'ADDRESS; + + IF DER_VAR_ADDRESS /= IDENT_ADR(DER_VAR'ADDRESS) THEN + FAILED ("IMPROPER VALUE FOR DER_VAR'ADDRESS"); + END IF; + + DER_EQUAL := IDENT_DER(1000); + + IF DER_VAR /= DER_EQUAL THEN + FAILED ("IMPROPER RESULT FROM INEQUALITY OPERATOR"); + END IF; + + DER_UNEQUAL := IDENT_DER(500); + + IF DER_VAR = DER_UNEQUAL THEN + FAILED ("IMPROPER RESULT FROM EQUALITY OPERATOR"); + END IF; + + IF DER_VAR < DER_UNEQUAL THEN + FAILED ("IMPROPER RESULT FROM LESS THAN OPERATOR"); + END IF; + + IF DER_VAR <= DER_UNEQUAL THEN + FAILED ("IMPROPER RESULT FROM LESS THAN OR EQUAL TO " & + "OPERATOR"); + END IF; + + DER_GREATER := IDENT_DER(1500); + + IF DER_VAR > DER_GREATER THEN + FAILED ("IMPROPER RESULT FROM GREATER THAN OPERATOR"); + END IF; + + IF DER_VAR >= DER_GREATER THEN + FAILED ("IMPROPER RESULT FROM GREATER THAN OR EQUAL " & + "TO OPERATOR"); + END IF; + + DER_VAR := DER_VAR + DER_EQUAL; + + IF DER_VAR /= IDENT_DER(2000) THEN + FAILED ("IMPROPER RESULT FROM ADDITION OPERATOR"); + END IF; + + DER_VAR := DER_VAR - DER_EQUAL; + + IF DER_VAR /= IDENT_DER(1000) THEN + FAILED ("IMPROPER RESULT FROM SUBTRACTION OPERATOR"); + END IF; + + DER_VAR := DER_VAR * IDENT_DER(2); + + IF DER_VAR /= IDENT_DER(2000) THEN + FAILED ("IMPROPER RESULT FROM MULTIPLICATION OPERATOR"); + END IF; + + DER_VAR := DER_VAR / IDENT_DER(2); + + IF DER_VAR /= IDENT_DER(1000) THEN + FAILED ("IMPROPER RESULT FROM DIVISION OPERATOR"); + END IF; + + DER_MOD := DER_GREATER MOD DER_VAR; + + IF DER_MOD /= IDENT_DER(500) THEN + FAILED ("IMPROPER RESULT FROM MOD OPERATOR"); + END IF; + + DER_REM := DER_GREATER REM DER_VAR; + + IF DER_REM /= IDENT_DER(500) THEN + FAILED ("IMPROPER RESULT FROM REM OPERATOR"); + END IF; + + DER_ABS := ABS(IDENT_DER(-1500)); + + IF DER_ABS /= IDENT_DER(DER_GREATER) THEN + FAILED ("IMPROPER RESULT FROM ABS OPERATOR"); + END IF; + + DER_EXP := IDENT_DER(2) ** IDENT_INT(2); + + IF DER_EXP /= IDENT_DER(4) THEN + FAILED ("IMPROPER RESULT FROM EXPONENTIATION OPERATOR"); + END IF; + + RESULT; + END P; + + PACKAGE PACK IS NEW P(INTEGER); + +BEGIN + NULL; +END CC1227A; |