| -- CC1225A.TST |
| |
| -- 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, FOR A FORMAL ACCESS TYPE, THAT ALL ALLOWABLE OPERATIONS |
| -- ARE IMPLICITLY DECLARED. |
| |
| -- MACRO SUBSTITUTION: |
| -- $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR |
| -- THE ACTIVATION OF A TASK. |
| |
| -- HISTORY: |
| -- BCB 03/29/88 CREATED ORIGINAL TEST. |
| -- RDH 04/09/90 ADDED 'STORAGE_SIZE CLAUSES. CHANGED EXTENSION TO |
| -- 'TST'. |
| -- LDC 09/26/90 REMOVED 'USE PACK' AFTER THE WITH SINCE IT ISN'T |
| -- NEEDED, ADDED CHECK FOR NULL AFTER ASSIGMENT TO |
| -- NULL, ADDED CHECKS FOR OTHER RELATION OPERATORS, |
| -- CHANGED CHECK FOR 'ADDRESS TO A PROCEDURE CALL. |
| -- LDC 10/13/90 CHANGED CHECK FOR 'SIZE TO ONLY CHECK FOR |
| -- AVAILABILITY. CHANGED CHECK FOR 'ADDRESS TO A |
| -- MEMBERSHIP TEST. |
| -- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X. |
| |
| WITH REPORT; USE REPORT; |
| WITH SYSTEM; USE SYSTEM; |
| |
| PROCEDURE CC1225A IS |
| |
| TASK_STORAGE_SIZE : CONSTANT := $TASK_STORAGE_SIZE; |
| |
| TYPE AI IS ACCESS INTEGER; |
| |
| TYPE ACCINTEGER IS ACCESS INTEGER; |
| |
| TYPE REC IS RECORD |
| COMP : INTEGER; |
| END RECORD; |
| |
| TYPE DISCREC (DISC : INTEGER := 1) IS RECORD |
| COMPD : INTEGER; |
| END RECORD; |
| |
| TYPE AREC IS ACCESS REC; |
| |
| TYPE ADISCREC IS ACCESS DISCREC; |
| |
| TYPE ARR IS ARRAY(1..2,1..2) OF INTEGER; |
| |
| TYPE ONEDIM IS ARRAY(1..10) OF INTEGER; |
| |
| TYPE AA IS ACCESS ARR; |
| |
| TYPE AONEDIM IS ACCESS ONEDIM; |
| |
| TYPE ENUM IS (ONE, TWO, THREE); |
| |
| TASK TYPE T IS |
| ENTRY HERE(VAL : IN OUT INTEGER); |
| END T; |
| |
| TYPE ATASK IS ACCESS T; |
| |
| TYPE ANOTHERTASK IS ACCESS T; |
| FOR ANOTHERTASK'STORAGE_SIZE USE 2 * TASK_STORAGE_SIZE; |
| |
| TASK TYPE T1 IS |
| ENTRY HERE1(ENUM)(VAL1 : IN OUT INTEGER); |
| END T1; |
| |
| TYPE ATASK1 IS ACCESS T1; |
| |
| TASK BODY T IS |
| BEGIN |
| ACCEPT HERE(VAL : IN OUT INTEGER) DO |
| VAL := VAL * 2; |
| END HERE; |
| END T; |
| |
| TASK BODY T1 IS |
| BEGIN |
| SELECT |
| ACCEPT HERE1(ONE)(VAL1 : IN OUT INTEGER) DO |
| VAL1 := VAL1 * 1; |
| END HERE1; |
| OR |
| ACCEPT HERE1(TWO)(VAL1 : IN OUT INTEGER) DO |
| VAL1 := VAL1 * 2; |
| END HERE1; |
| OR |
| ACCEPT HERE1(THREE)(VAL1 : IN OUT INTEGER) DO |
| VAL1 := VAL1 * 3; |
| END HERE1; |
| END SELECT; |
| END T1; |
| |
| GENERIC |
| TYPE FORM IS (<>); |
| TYPE ACCFORM IS ACCESS FORM; |
| TYPE ACC IS ACCESS INTEGER; |
| TYPE ACCREC IS ACCESS REC; |
| TYPE ACCDISCREC IS ACCESS DISCREC; |
| TYPE ACCARR IS ACCESS ARR; |
| TYPE ACCONE IS ACCESS ONEDIM; |
| TYPE ACCTASK IS ACCESS T; |
| TYPE ACCTASK1 IS ACCESS T1; |
| TYPE ANOTHERTASK1 IS ACCESS T; |
| PACKAGE P IS |
| END P; |
| |
| PACKAGE BODY P IS |
| AF : ACCFORM; |
| TYPE DER_ACC IS NEW ACC; |
| A, B : ACC; |
| DERA : DER_ACC; |
| R : ACCREC; |
| DR : ACCDISCREC; |
| C : ACCARR; |
| D, E : ACCONE; |
| F : ACCTASK; |
| G : ACCTASK1; |
| INT : INTEGER := 5; |
| |
| BEGIN |
| TEST ("CC1225A", "CHECK, FOR A FORMAL ACCESS TYPE, THAT " & |
| "ALL ALLOWABLE OPERATIONS ARE IMPLICITLY " & |
| "DECLARED"); |
| |
| IF AF'ADDRESS NOT IN ADDRESS THEN |
| FAILED ("IMPROPER RESULT FROM AF'ADDRESS TEST"); |
| END IF; |
| |
| DECLARE |
| AF_SIZE : INTEGER := ACCFORM'SIZE; |
| BEGIN |
| IF AF_SIZE NOT IN INTEGER THEN |
| FAILED ("IMPROPER RESULT FROM AF'SIZE"); |
| END IF; |
| END; |
| |
| IF ANOTHERTASK1'STORAGE_SIZE < TASK_STORAGE_SIZE THEN |
| FAILED ("IMPROPER VALUE FOR ANOTHERTASK1'STORAGE_SIZE"); |
| END IF; |
| |
| B := NEW INTEGER'(25); |
| |
| A := B; |
| |
| IF A.ALL /= 25 THEN |
| FAILED ("IMPROPER VALUE FOR ASSIGNMENT OF VARIABLE " & |
| "OF A FORMAL ACCESS TYPE FROM ANOTHER " & |
| "VARIABLE OF A FORMAL ACCESS TYPE"); |
| END IF; |
| |
| A := NEW INTEGER'(10); |
| |
| IF A.ALL /= 10 THEN |
| FAILED ("IMPROPER VALUE FOR VARIABLE OF FORMAL ACCESS " & |
| "TYPE"); |
| END IF; |
| |
| IF A NOT IN ACC THEN |
| FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST"); |
| END IF; |
| |
| B := ACC'(A); |
| |
| IF B.ALL /= 10 THEN |
| FAILED ("IMPROPER VALUE FROM QUALIFICATION"); |
| END IF; |
| |
| DERA := NEW INTEGER'(10); |
| A := ACC(DERA); |
| |
| IF A.ALL /= IDENT_INT(10) THEN |
| FAILED ("IMPROPER VALUE FROM EXPLICIT CONVERSION"); |
| END IF; |
| |
| IF A.ALL > IDENT_INT(10) THEN |
| FAILED ("IMPROPER VALUE USED IN LESS THAN"); |
| END IF; |
| |
| IF A.ALL < IDENT_INT(10) THEN |
| FAILED ("IMPROPER VALUE USED IN GREATER THAN"); |
| END IF; |
| |
| IF A.ALL >= IDENT_INT(11) THEN |
| FAILED ("IMPROPER VALUE USED IN LESS THAN OR EQUAL"); |
| END IF; |
| |
| IF A.ALL <= IDENT_INT(9) THEN |
| FAILED ("IMPROPER VALUE USED IN GREATER THAN OR EQUAL"); |
| END IF; |
| |
| IF NOT (A.ALL + A.ALL = IDENT_INT(20)) THEN |
| FAILED ("IMPROPER VALUE FROM ADDITION"); |
| END IF; |
| |
| IF NOT (A.ALL - IDENT_INT(2) = IDENT_INT(8)) THEN |
| FAILED ("IMPROPER VALUE FROM SUBTRACTION"); |
| END IF; |
| |
| IF NOT (A.ALL * IDENT_INT(3) = IDENT_INT(30)) THEN |
| FAILED ("IMPROPER VALUE FROM MULTIPLICATION"); |
| END IF; |
| |
| IF NOT (A.ALL / IDENT_INT(3) = IDENT_INT(3)) THEN |
| FAILED ("IMPROPER VALUE FROM DIVISION"); |
| END IF; |
| |
| IF NOT (A.ALL MOD IDENT_INT(3) = IDENT_INT(1)) THEN |
| FAILED ("IMPROPER VALUE FROM MODULO"); |
| END IF; |
| |
| IF NOT (A.ALL REM IDENT_INT(7) = IDENT_INT(3)) THEN |
| FAILED ("IMPROPER VALUE FROM REMAINDER"); |
| END IF; |
| |
| IF NOT (A.ALL ** IDENT_INT(2) = IDENT_INT(100)) THEN |
| FAILED ("IMPROPER VALUE FROM EXPONENTIATION"); |
| END IF; |
| |
| IF NOT (+A.ALL = IDENT_INT(10)) THEN |
| FAILED ("IMPROPER VALUE FROM IDENTITY"); |
| END IF; |
| |
| IF NOT (-A.ALL = IDENT_INT(-10)) THEN |
| FAILED ("IMPROPER VALUE FROM NEGATION"); |
| END IF; |
| |
| A := NULL; |
| |
| IF A /= NULL THEN |
| FAILED ("IMPROPER VALUE FROM ACCESS SET TO NULL"); |
| END IF; |
| |
| IF A'ADDRESS NOT IN ADDRESS THEN |
| FAILED ("IMPROPER RESULT FROM A'ADDRESS TEST"); |
| END IF; |
| |
| |
| DECLARE |
| ACC_SIZE : INTEGER := ACC'SIZE; |
| BEGIN |
| IF ACC_SIZE NOT IN INTEGER THEN |
| FAILED ("IMPROPER RESULT FROM ACC'SIZE"); |
| END IF; |
| END; |
| |
| R := NEW REC'(COMP => 5); |
| |
| IF NOT EQUAL(R.COMP,5) THEN |
| FAILED ("IMPROPER VALUE FOR RECORD COMPONENT"); |
| END IF; |
| |
| DR := NEW DISCREC'(DISC => 1, COMPD => 5); |
| |
| IF NOT EQUAL(DR.DISC,1) OR NOT EQUAL(DR.COMPD,5) THEN |
| FAILED ("IMPROPER VALUES FOR DISCRIMINATED RECORD " & |
| "COMPONENTS"); |
| END IF; |
| |
| C := NEW ARR'(1 => (1,2), 2 => (3,4)); |
| |
| IF C(1,1) /= 1 OR C(1,2) /= 2 OR C(2,1) /= 3 OR C(2,2) /= 4 |
| THEN FAILED ("IMPROPER ARRAY COMPONENT VALUES"); |
| END IF; |
| |
| D := NEW ONEDIM'(1,2,3,4,5,6,7,8,9,10); |
| E := NEW ONEDIM'(10,9,8,7,6,5,4,3,2,1); |
| |
| D(1..5) := E(1..5); |
| |
| IF D(1) /= 10 OR D(2) /= 9 OR D(3) /= 8 |
| OR D(4) /= 7 OR D(5) /= 6 THEN |
| FAILED ("IMPROPER RESULTS FROM SLICE ASSIGNMENT"); |
| END IF; |
| |
| IF C'FIRST /= 1 OR C'FIRST(2) /= 1 THEN |
| FAILED ("IMPROPER LOWER BOUNDS FOR CONSTRAINED ARRAY"); |
| END IF; |
| |
| IF C'LAST /= 2 OR C'LAST(2) /= 2 THEN |
| FAILED ("IMPROPER UPPER BOUNDS FOR CONSTRAINED ARRAY"); |
| END IF; |
| |
| IF 1 NOT IN C'RANGE THEN |
| FAILED ("IMPROPER RANGE FOR CONSTRAINED ARRAY - 1"); |
| END IF; |
| |
| IF 1 NOT IN C'RANGE(2) THEN |
| FAILED ("IMPROPER RANGE FOR CONSTRAINED ARRAY - 2"); |
| END IF; |
| |
| IF C'LENGTH /= 2 THEN |
| FAILED ("IMPROPER NUMBER OF VALUES FOR CONSTRAINED " & |
| "ARRAY - 1"); |
| END IF; |
| |
| IF C'LENGTH(2) /= 2 THEN |
| FAILED ("IMPROPER NUMBER OF VALUES FOR CONSTRAINED " & |
| "ARRAY - 2"); |
| END IF; |
| |
| F := NEW T; |
| |
| F.HERE(INT); |
| |
| IF NOT EQUAL(INT,IDENT_INT(10)) THEN |
| FAILED ("IMPROPER RESULTS FROM ENTRY SELECTION"); |
| END IF; |
| |
| G := NEW T1; |
| |
| G.HERE1(TWO)(INT); |
| |
| IF NOT EQUAL(INT,IDENT_INT(20)) THEN |
| FAILED ("IMPROPER RESULTS FROM FAMILY ENTRY SELECTION"); |
| END IF; |
| |
| RESULT; |
| END P; |
| |
| PACKAGE PACK IS NEW P(INTEGER,ACCINTEGER,AI,AREC,ADISCREC, |
| AA,AONEDIM,ATASK,ATASK1,ANOTHERTASK); |
| |
| BEGIN |
| NULL; |
| END CC1225A; |
