1-- C95089A.ADA 2 3-- Grant of Unlimited Rights 4-- 5-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, 6-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 7-- unlimited rights in the software and documentation contained herein. 8-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making 9-- this public release, the Government intends to confer upon all 10-- recipients unlimited rights equal to those held by the Government. 11-- These rights include rights to use, duplicate, release or disclose the 12-- released technical data and computer software in whole or in part, in 13-- any manner and for any purpose whatsoever, and to have or permit others 14-- to do so. 15-- 16-- DISCLAIMER 17-- 18-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 19-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 20-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE 21-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 22-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 23-- PARTICULAR PURPOSE OF SAID MATERIAL. 24--* 25-- CHECK THAT ALL PERMITTED FORMS OF VARIABLE NAMES ARE PERMITTED 26-- AS ACTUAL PARAMETERS. 27 28-- GLH 7/25/85 29 30WITH REPORT; USE REPORT; 31PROCEDURE C95089A IS 32 33 SUBTYPE INT IS INTEGER RANGE 1..3; 34 35 TYPE REC (N : INT) IS 36 RECORD 37 S : STRING (1..N); 38 END RECORD; 39 40 TYPE PTRSTR IS ACCESS STRING; 41 42 R1, R2, R3 : REC (3); 43 S1, S2, S3 : STRING (1..3); 44 PTRTBL : ARRAY (1..3) OF PTRSTR; 45 46 TASK T1 IS 47 ENTRY E1 (S1 : IN STRING; S2: IN OUT STRING; 48 S3 : OUT STRING); 49 END T1; 50 51 TASK BODY T1 IS 52 BEGIN 53 LOOP 54 SELECT 55 ACCEPT E1 (S1 : IN STRING; S2: IN OUT STRING; 56 S3 : OUT STRING) DO 57 S3 := S2; 58 S2 := S1; 59 END E1; 60 OR 61 TERMINATE; 62 END SELECT; 63 END LOOP; 64 END T1; 65 66 TASK T2 IS 67 ENTRY E2 (C1 : IN CHARACTER; C2 : IN OUT CHARACTER; 68 C3 : OUT CHARACTER); 69 END T2; 70 71 TASK BODY T2 IS 72 BEGIN 73 LOOP 74 SELECT 75 ACCEPT E2 (C1 : IN CHARACTER; C2 : IN OUT CHARACTER; 76 C3 : OUT CHARACTER) DO 77 C3 := C2; 78 C2 := C1; 79 END E2; 80 OR 81 TERMINATE; 82 END SELECT; 83 END LOOP; 84 END T2; 85 86 FUNCTION F1 (X : INT) RETURN PTRSTR IS 87 BEGIN 88 RETURN PTRTBL (X); 89 END F1; 90 91 FUNCTION "+" (S1, S2 : STRING) RETURN PTRSTR IS 92 BEGIN 93 RETURN PTRTBL (CHARACTER'POS(S1(1))-CHARACTER'POS('A')+1); 94 END "+"; 95 96BEGIN 97 98 TEST ("C95089A", "CHECK THAT ALL PERMITTED FORMS OF VARIABLE " & 99 "NAMES ARE PERMITTED AS ACTUAL PARAMETERS"); 100 101 S1 := "AAA"; 102 S2 := "BBB"; 103 T1.E1 (S1, S2, S3); 104 IF S2 /= "AAA" OR S3 /= "BBB" THEN 105 FAILED ("SIMPLE VARIABLE AS AN ACTUAL PARAMETER NOT WORKING"); 106 END IF; 107 108 S1 := "AAA"; 109 S2 := "BBB"; 110 S3 := IDENT_STR ("CCC"); 111 T2.E2 (S1(1), S2(IDENT_INT(1)), S3(1)); 112 IF S2 /= "ABB" OR S3 /= "BCC" THEN 113 FAILED ("INDEXED COMPONENT AS AN ACTUAL PARAMETER NOT " & 114 "WORKING"); 115 END IF; 116 117 R1.S := "AAA"; 118 R2.S := "BBB"; 119 T1.E1 (R1.S, R2.S, R3.S); 120 IF R2.S /= "AAA" OR R3.S /= "BBB" THEN 121 FAILED ("SELECTED COMPONENT AS AN ACTUAL PARAMETER " & 122 "NOT WORKING"); 123 END IF; 124 125 S1 := "AAA"; 126 S2 := "BBB"; 127 T1.E1 (S1(1..IDENT_INT(2)), S2(1..2), 128 S3(IDENT_INT(1)..IDENT_INT(2))); 129 IF S2 /= "AAB" OR S3 /= "BBC" THEN 130 FAILED ("SLICE AS AN ACTUAL PARAMETER NOT WORKING"); 131 END IF; 132 133 PTRTBL(1) := NEW STRING'("AAA"); 134 PTRTBL(2) := NEW STRING'("BBB"); 135 PTRTBL(3) := NEW STRING'("CCC"); 136 T1.E1 (F1(1).ALL, F1(2).ALL, F1(IDENT_INT(3)).ALL); 137 IF PTRTBL(2).ALL /= "AAA" OR PTRTBL(3).ALL /= "BBB" THEN 138 FAILED ("SELECTED COMPONENT OF FUNCTION VALUE AS AN ACTUAL " & 139 "PARAMETER NOT WORKING"); 140 END IF; 141 142 PTRTBL(1) := NEW STRING'("AAA"); 143 PTRTBL(2) := NEW STRING'("BBB"); 144 PTRTBL(3) := NEW STRING'("CCC"); 145 S1 := IDENT_STR("AAA"); 146 S2 := IDENT_STR("BBB"); 147 S3 := IDENT_STR("CCC"); 148 T1.E1 ("+"(S1,S1).ALL, "+"(S2,S2).ALL, "+"(S3,S3).ALL); 149 IF PTRTBL(2).ALL /= "AAA" OR PTRTBL(3).ALL /= "BBB" THEN 150 FAILED ("SELECTED COMPONENT OF OVERLOADED OPERATOR " & 151 "FUNCTION VALUE AS AN ACTUAL PARAMETER NOT WORKING"); 152 END IF; 153 154 PTRTBL(1) := NEW STRING'("AAA"); 155 PTRTBL(2) := NEW STRING'("BBB"); 156 PTRTBL(3) := NEW STRING'("CCC"); 157 T2.E2 (F1(1)(1), F1(IDENT_INT(2))(1), F1(3)(IDENT_INT(1))); 158 IF PTRTBL(2).ALL /= "ABB" OR PTRTBL(3).ALL /= "BCC" THEN 159 FAILED ("INDEXED COMPONENT OF FUNCTION VALUE AS AN ACTUAL " & 160 "PARAMETER NOT WORKING"); 161 END IF; 162 163 PTRTBL(1) := NEW STRING'("AAA"); 164 PTRTBL(2) := NEW STRING'("BBB"); 165 PTRTBL(3) := NEW STRING'("CCC"); 166 T1.E1 (F1(1)(2..3), F1(2)(IDENT_INT(2)..3), 167 F1(3)(2..IDENT_INT(3))); 168 IF PTRTBL(2).ALL /= "BAA" OR PTRTBL(3).ALL /= "CBB" THEN 169 FAILED ("SLICE OF FUNCTION VALUE AS AN ACTUAL PARAMETER " & 170 "NOT WORKING"); 171 END IF; 172 173 RESULT; 174 175END C95089A; 176