git://gcc.gnu.org / gcc.git / blame
| Commit | Line | Data |
|---|---|---|
| 19235870 RK |
1 | ------------------------------------------------------------------------------ |
| 2 | -- -- | |
| 3 | -- GNAT COMPILER COMPONENTS -- | |
| 4 | -- -- | |
| 5 | -- P A R . C H 1 3 -- | |
| 6 | -- -- | |
| 7 | -- B o d y -- | |
| 8 | -- -- | |
| b3aa0ca8 | 9 | -- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- |
| 19235870 RK |
10 | -- -- |
| 11 | -- GNAT is free software; you can redistribute it and/or modify it under -- | |
| 12 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
| b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| 19235870 RK |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| 15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
| 16 | -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- | |
| 17 | -- for more details. You should have received a copy of the GNU General -- | |
| b5c84c3c RD |
18 | -- Public License distributed with GNAT; see file COPYING3. If not, go to -- |
| 19 | -- http://www.gnu.org/licenses for a complete copy of the license. -- | |
| 19235870 RK |
20 | -- -- |
| 21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
| 71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| 19235870 RK |
23 | -- -- |
| 24 | ------------------------------------------------------------------------------ | |
| 25 | ||
| 26 | pragma Style_Checks (All_Checks); | |
| 27 | -- Turn off subprogram body ordering check. Subprograms are in order | |
| 28 | -- by RM section rather than alphabetical | |
| 29 | ||
| 30 | separate (Par) | |
| 31 | package body Ch13 is | |
| 32 | ||
| 33 | -- Local functions, used only in this chapter | |
| 34 | ||
| 35 | function P_Component_Clause return Node_Id; | |
| 36 | function P_Mod_Clause return Node_Id; | |
| 37 | ||
| 0f1a6a0b AC |
38 | ----------------------------------- |
| 39 | -- Aspect_Specifications_Present -- | |
| 40 | ----------------------------------- | |
| 41 | ||
| 39231404 AC |
42 | function Aspect_Specifications_Present |
| 43 | (Strict : Boolean := Ada_Version < Ada_2012) return Boolean | |
| 44 | is | |
| 0f1a6a0b AC |
45 | Scan_State : Saved_Scan_State; |
| 46 | Result : Boolean; | |
| 47 | ||
| 48 | begin | |
| eaba57fb | 49 | -- Definitely must have WITH to consider aspect specs to be present |
| 39231404 | 50 | |
| eaba57fb RD |
51 | -- Note that this means that if we have a semicolon, we immediately |
| 52 | -- return False. There is a case in which this is not optimal, namely | |
| 53 | -- something like | |
| 0f1a6a0b | 54 | |
| eaba57fb RD |
55 | -- type R is new Integer; |
| 56 | -- with bla bla; | |
| 0f1a6a0b | 57 | |
| eaba57fb RD |
58 | -- where the semicolon is redundant, but scanning forward for it would |
| 59 | -- be too expensive. Instead we pick up the aspect specifications later | |
| 60 | -- as a bogus declaration, and diagnose the semicolon at that point. | |
| 0f1a6a0b AC |
61 | |
| 62 | if Token /= Tok_With then | |
| 63 | return False; | |
| 64 | end if; | |
| 65 | ||
| 66 | -- Have a WITH, see if it looks like an aspect specification | |
| 67 | ||
| 68 | Save_Scan_State (Scan_State); | |
| 69 | Scan; -- past WITH | |
| 70 | ||
| 71 | -- If no identifier, then consider that we definitely do not have an | |
| 72 | -- aspect specification. | |
| 73 | ||
| 74 | if Token /= Tok_Identifier then | |
| 75 | Result := False; | |
| 76 | ||
| 39231404 AC |
77 | -- This is where we pay attention to the Strict mode. Normally when we |
| 78 | -- are in Ada 2012 mode, Strict is False, and we consider that we have | |
| 0f1a6a0b AC |
79 | -- an aspect specification if the identifier is an aspect name (even if |
| 80 | -- not followed by =>) or the identifier is not an aspect name but is | |
| 81 | -- followed by =>. P_Aspect_Specifications will generate messages if the | |
| 82 | -- aspect specification is ill-formed. | |
| 83 | ||
| 39231404 | 84 | elsif not Strict then |
| 0f1a6a0b AC |
85 | if Get_Aspect_Id (Token_Name) /= No_Aspect then |
| 86 | Result := True; | |
| 87 | else | |
| 88 | Scan; -- past identifier | |
| 89 | Result := Token = Tok_Arrow; | |
| 90 | end if; | |
| 91 | ||
| 78efd712 AC |
92 | -- If earlier than Ada 2012, check for valid aspect identifier (possibly |
| 93 | -- completed with 'CLASS) followed by an arrow, and consider that this | |
| 94 | -- is still an aspect specification so we give an appropriate message. | |
| 0f1a6a0b AC |
95 | |
| 96 | else | |
| 97 | if Get_Aspect_Id (Token_Name) = No_Aspect then | |
| 98 | Result := False; | |
| 99 | ||
| 100 | else | |
| 101 | Scan; -- past aspect name | |
| 102 | ||
| 78efd712 AC |
103 | Result := False; |
| 104 | ||
| 105 | if Token = Tok_Arrow then | |
| 106 | Result := True; | |
| 107 | ||
| 108 | elsif Token = Tok_Apostrophe then | |
| 109 | Scan; -- past apostrophe | |
| 110 | ||
| 111 | if Token = Tok_Identifier | |
| 112 | and then Token_Name = Name_Class | |
| 113 | then | |
| 114 | Scan; -- past CLASS | |
| 115 | ||
| 116 | if Token = Tok_Arrow then | |
| 117 | Result := True; | |
| 118 | end if; | |
| 119 | end if; | |
| 120 | end if; | |
| 0f1a6a0b | 121 | |
| 78efd712 | 122 | if Result then |
| 0f1a6a0b AC |
123 | Restore_Scan_State (Scan_State); |
| 124 | Error_Msg_SC ("|aspect specification is an Ada 2012 feature"); | |
| 125 | Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch"); | |
| 126 | return True; | |
| 127 | end if; | |
| 128 | end if; | |
| 129 | end if; | |
| 130 | ||
| 131 | Restore_Scan_State (Scan_State); | |
| 132 | return Result; | |
| 133 | end Aspect_Specifications_Present; | |
| 134 | ||
| 19235870 RK |
135 | -------------------------------------------- |
| 136 | -- 13.1 Representation Clause (also I.7) -- | |
| 137 | -------------------------------------------- | |
| 138 | ||
| 139 | -- REPRESENTATION_CLAUSE ::= | |
| 140 | -- ATTRIBUTE_DEFINITION_CLAUSE | |
| 141 | -- | ENUMERATION_REPRESENTATION_CLAUSE | |
| 142 | -- | RECORD_REPRESENTATION_CLAUSE | |
| 143 | -- | AT_CLAUSE | |
| 144 | ||
| 145 | -- ATTRIBUTE_DEFINITION_CLAUSE ::= | |
| 146 | -- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION; | |
| 147 | -- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME; | |
| 148 | ||
| 149 | -- Note: in Ada 83, the expression must be a simple expression | |
| 150 | ||
| 151 | -- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION; | |
| 152 | ||
| 153 | -- Note: in Ada 83, the expression must be a simple expression | |
| 154 | ||
| 155 | -- ENUMERATION_REPRESENTATION_CLAUSE ::= | |
| 156 | -- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE; | |
| 157 | ||
| 158 | -- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE | |
| 159 | ||
| 160 | -- RECORD_REPRESENTATION_CLAUSE ::= | |
| 161 | -- for first_subtype_LOCAL_NAME use | |
| 162 | -- record [MOD_CLAUSE] | |
| 163 | -- {COMPONENT_CLAUSE} | |
| 164 | -- end record; | |
| 165 | ||
| 166 | -- Note: for now we allow only a direct name as the local name in the | |
| 167 | -- above constructs. This probably needs changing later on ??? | |
| 168 | ||
| 169 | -- The caller has checked that the initial token is FOR | |
| 170 | ||
| 171 | -- Error recovery: cannot raise Error_Resync, if an error occurs, | |
| 172 | -- the scan is repositioned past the next semicolon. | |
| 173 | ||
| 174 | function P_Representation_Clause return Node_Id is | |
| 175 | For_Loc : Source_Ptr; | |
| 176 | Name_Node : Node_Id; | |
| 177 | Prefix_Node : Node_Id; | |
| 178 | Attr_Name : Name_Id; | |
| 179 | Identifier_Node : Node_Id; | |
| 180 | Rep_Clause_Node : Node_Id; | |
| 181 | Expr_Node : Node_Id; | |
| 182 | Record_Items : List_Id; | |
| 183 | ||
| 184 | begin | |
| 185 | For_Loc := Token_Ptr; | |
| 186 | Scan; -- past FOR | |
| 187 | ||
| 188 | -- Note that the name in a representation clause is always a simple | |
| 189 | -- name, even in the attribute case, see AI-300 which made this so! | |
| 190 | ||
| bde58e32 | 191 | Identifier_Node := P_Identifier (C_Use); |
| 19235870 RK |
192 | |
| 193 | -- Check case of qualified name to give good error message | |
| 194 | ||
| 195 | if Token = Tok_Dot then | |
| 196 | Error_Msg_SC | |
| 197 | ("representation clause requires simple name!"); | |
| 198 | ||
| 199 | loop | |
| 200 | exit when Token /= Tok_Dot; | |
| 201 | Scan; -- past dot | |
| 202 | Discard_Junk_Node (P_Identifier); | |
| 203 | end loop; | |
| 204 | end if; | |
| 205 | ||
| 206 | -- Attribute Definition Clause | |
| 207 | ||
| 208 | if Token = Tok_Apostrophe then | |
| 209 | ||
| 210 | -- Allow local names of the form a'b'.... This enables | |
| 211 | -- us to parse class-wide streams attributes correctly. | |
| 212 | ||
| 213 | Name_Node := Identifier_Node; | |
| 214 | while Token = Tok_Apostrophe loop | |
| 215 | ||
| 216 | Scan; -- past apostrophe | |
| 217 | ||
| 218 | Identifier_Node := Token_Node; | |
| 219 | Attr_Name := No_Name; | |
| 220 | ||
| 221 | if Token = Tok_Identifier then | |
| 222 | Attr_Name := Token_Name; | |
| 223 | ||
| 224 | if not Is_Attribute_Name (Attr_Name) then | |
| 225 | Signal_Bad_Attribute; | |
| 226 | end if; | |
| 227 | ||
| 228 | if Style_Check then | |
| 229 | Style.Check_Attribute_Name (False); | |
| 230 | end if; | |
| 231 | ||
| 232 | -- Here for case of attribute designator is not an identifier | |
| 233 | ||
| 234 | else | |
| 235 | if Token = Tok_Delta then | |
| 236 | Attr_Name := Name_Delta; | |
| 237 | ||
| 238 | elsif Token = Tok_Digits then | |
| 239 | Attr_Name := Name_Digits; | |
| 240 | ||
| 241 | elsif Token = Tok_Access then | |
| 242 | Attr_Name := Name_Access; | |
| 243 | ||
| 244 | else | |
| 245 | Error_Msg_AP ("attribute designator expected"); | |
| 246 | raise Error_Resync; | |
| 247 | end if; | |
| 248 | ||
| 249 | if Style_Check then | |
| 250 | Style.Check_Attribute_Name (True); | |
| 251 | end if; | |
| 252 | end if; | |
| 253 | ||
| 254 | -- We come here with an OK attribute scanned, and the | |
| 255 | -- corresponding Attribute identifier node stored in Ident_Node. | |
| 256 | ||
| 257 | Prefix_Node := Name_Node; | |
| 258 | Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr); | |
| 259 | Set_Prefix (Name_Node, Prefix_Node); | |
| 260 | Set_Attribute_Name (Name_Node, Attr_Name); | |
| 261 | Scan; | |
| 262 | end loop; | |
| 263 | ||
| 264 | Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc); | |
| 265 | Set_Name (Rep_Clause_Node, Prefix_Node); | |
| 266 | Set_Chars (Rep_Clause_Node, Attr_Name); | |
| 267 | T_Use; | |
| 268 | ||
| 269 | Expr_Node := P_Expression_No_Right_Paren; | |
| 270 | Check_Simple_Expression_In_Ada_83 (Expr_Node); | |
| 271 | Set_Expression (Rep_Clause_Node, Expr_Node); | |
| 272 | ||
| 273 | else | |
| 274 | TF_Use; | |
| 275 | Rep_Clause_Node := Empty; | |
| 276 | ||
| 277 | -- AT follows USE (At Clause) | |
| 278 | ||
| 279 | if Token = Tok_At then | |
| 280 | Scan; -- past AT | |
| 281 | Rep_Clause_Node := New_Node (N_At_Clause, For_Loc); | |
| 282 | Set_Identifier (Rep_Clause_Node, Identifier_Node); | |
| 283 | Expr_Node := P_Expression_No_Right_Paren; | |
| 284 | Check_Simple_Expression_In_Ada_83 (Expr_Node); | |
| 285 | Set_Expression (Rep_Clause_Node, Expr_Node); | |
| 286 | ||
| 287 | -- RECORD follows USE (Record Representation Clause) | |
| 288 | ||
| 289 | elsif Token = Tok_Record then | |
| 290 | Record_Items := P_Pragmas_Opt; | |
| 291 | Rep_Clause_Node := | |
| 292 | New_Node (N_Record_Representation_Clause, For_Loc); | |
| 293 | Set_Identifier (Rep_Clause_Node, Identifier_Node); | |
| 294 | ||
| 295 | Push_Scope_Stack; | |
| 296 | Scope.Table (Scope.Last).Etyp := E_Record; | |
| 297 | Scope.Table (Scope.Last).Ecol := Start_Column; | |
| 298 | Scope.Table (Scope.Last).Sloc := Token_Ptr; | |
| 299 | Scan; -- past RECORD | |
| 300 | Record_Items := P_Pragmas_Opt; | |
| 301 | ||
| 302 | -- Possible Mod Clause | |
| 303 | ||
| 304 | if Token = Tok_At then | |
| 305 | Set_Mod_Clause (Rep_Clause_Node, P_Mod_Clause); | |
| 306 | Set_Pragmas_Before (Mod_Clause (Rep_Clause_Node), Record_Items); | |
| 307 | Record_Items := P_Pragmas_Opt; | |
| 308 | end if; | |
| 309 | ||
| 310 | if No (Record_Items) then | |
| 311 | Record_Items := New_List; | |
| 312 | end if; | |
| 313 | ||
| 314 | Set_Component_Clauses (Rep_Clause_Node, Record_Items); | |
| 315 | ||
| 316 | -- Loop through component clauses | |
| 317 | ||
| 318 | loop | |
| 319 | if Token not in Token_Class_Name then | |
| 320 | exit when Check_End; | |
| 321 | end if; | |
| 322 | ||
| 323 | Append (P_Component_Clause, Record_Items); | |
| 324 | P_Pragmas_Opt (Record_Items); | |
| 325 | end loop; | |
| 326 | ||
| 327 | -- Left paren follows USE (Enumeration Representation Clause) | |
| 328 | ||
| 329 | elsif Token = Tok_Left_Paren then | |
| 330 | Rep_Clause_Node := | |
| 331 | New_Node (N_Enumeration_Representation_Clause, For_Loc); | |
| 332 | Set_Identifier (Rep_Clause_Node, Identifier_Node); | |
| 333 | Set_Array_Aggregate (Rep_Clause_Node, P_Aggregate); | |
| 334 | ||
| 335 | -- Some other token follows FOR (invalid representation clause) | |
| 336 | ||
| 337 | else | |
| 338 | Error_Msg_SC ("invalid representation clause"); | |
| 339 | raise Error_Resync; | |
| 340 | end if; | |
| 341 | end if; | |
| 342 | ||
| 343 | TF_Semicolon; | |
| 344 | return Rep_Clause_Node; | |
| 345 | ||
| 346 | exception | |
| 347 | when Error_Resync => | |
| 348 | Resync_Past_Semicolon; | |
| 349 | return Error; | |
| 350 | ||
| 351 | end P_Representation_Clause; | |
| 352 | ||
| 353 | ---------------------- | |
| 354 | -- 13.1 Local Name -- | |
| 355 | ---------------------- | |
| 356 | ||
| 357 | -- Local name is always parsed by its parent. In the case of its use in | |
| 358 | -- pragmas, the check for a local name is handled in Par.Prag and allows | |
| 359 | -- all the possible forms of local name. For the uses in chapter 13, we | |
| 360 | -- currently only allow a direct name, but this should probably change??? | |
| 361 | ||
| 362 | --------------------------- | |
| 363 | -- 13.1 At Clause (I.7) -- | |
| 364 | --------------------------- | |
| 365 | ||
| 366 | -- Parsed by P_Representation_Clause (13.1) | |
| 367 | ||
| 368 | --------------------------------------- | |
| 369 | -- 13.3 Attribute Definition Clause -- | |
| 370 | --------------------------------------- | |
| 371 | ||
| 372 | -- Parsed by P_Representation_Clause (13.1) | |
| 373 | ||
| 308e6f3a RW |
374 | -------------------------------- |
| 375 | -- 13.1 Aspect Specification -- | |
| 376 | -------------------------------- | |
| 0f1a6a0b AC |
377 | |
| 378 | -- ASPECT_SPECIFICATION ::= | |
| 1c163178 | 379 | -- with ASPECT_MARK [=> ASPECT_DEFINITION] {, |
| 0f1a6a0b AC |
380 | -- ASPECT_MARK [=> ASPECT_DEFINITION] } |
| 381 | ||
| 382 | -- ASPECT_MARK ::= aspect_IDENTIFIER['Class] | |
| 383 | ||
| 384 | -- ASPECT_DEFINITION ::= NAME | EXPRESSION | |
| 385 | ||
| 386 | -- Error recovery: cannot raise Error_Resync | |
| 387 | ||
| 1c54829e AC |
388 | procedure P_Aspect_Specifications |
| 389 | (Decl : Node_Id; | |
| 390 | Semicolon : Boolean := True) | |
| 391 | is | |
| 0f1a6a0b AC |
392 | Aspects : List_Id; |
| 393 | Aspect : Node_Id; | |
| 394 | A_Id : Aspect_Id; | |
| 395 | OK : Boolean; | |
| 718deaf1 | 396 | Ptr : Source_Ptr; |
| 0f1a6a0b AC |
397 | |
| 398 | begin | |
| 399 | -- Check if aspect specification present | |
| 400 | ||
| 401 | if not Aspect_Specifications_Present then | |
| 1c54829e AC |
402 | if Semicolon then |
| 403 | TF_Semicolon; | |
| 404 | end if; | |
| 405 | ||
| 0f1a6a0b AC |
406 | return; |
| 407 | end if; | |
| 408 | ||
| 409 | -- Aspect Specification is present | |
| 410 | ||
| 718deaf1 | 411 | Ptr := Token_Ptr; |
| 0f1a6a0b AC |
412 | Scan; -- past WITH |
| 413 | ||
| 1c163178 | 414 | -- Here we have an aspect specification to scan, note that we don't |
| 0f1a6a0b AC |
415 | -- set the flag till later, because it may turn out that we have no |
| 416 | -- valid aspects in the list. | |
| 417 | ||
| 418 | Aspects := Empty_List; | |
| 419 | loop | |
| 420 | OK := True; | |
| 421 | ||
| 422 | if Token /= Tok_Identifier then | |
| 423 | Error_Msg_SC ("aspect identifier expected"); | |
| 1c54829e AC |
424 | |
| 425 | if Semicolon then | |
| 426 | Resync_Past_Semicolon; | |
| 427 | end if; | |
| 428 | ||
| 0f1a6a0b AC |
429 | return; |
| 430 | end if; | |
| 431 | ||
| 432 | -- We have an identifier (which should be an aspect identifier) | |
| 433 | ||
| 0f1a6a0b AC |
434 | A_Id := Get_Aspect_Id (Token_Name); |
| 435 | Aspect := | |
| 811ef5ba | 436 | Make_Aspect_Specification (Token_Ptr, |
| 0f1a6a0b AC |
437 | Identifier => Token_Node); |
| 438 | ||
| 439 | -- No valid aspect identifier present | |
| 440 | ||
| 441 | if A_Id = No_Aspect then | |
| 442 | Error_Msg_SC ("aspect identifier expected"); | |
| 443 | ||
| c228a069 AC |
444 | -- Check bad spelling |
| 445 | ||
| 19fb051c AC |
446 | for J in Aspect_Id loop |
| 447 | if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then | |
| 448 | Error_Msg_Name_1 := Aspect_Names (J); | |
| c228a069 AC |
449 | Error_Msg_SC -- CODEFIX |
| 450 | ("\possible misspelling of%"); | |
| 451 | exit; | |
| 452 | end if; | |
| 453 | end loop; | |
| 454 | ||
| 455 | Scan; -- past incorrect identifier | |
| 456 | ||
| 0f1a6a0b AC |
457 | if Token = Tok_Apostrophe then |
| 458 | Scan; -- past ' | |
| 459 | Scan; -- past presumably CLASS | |
| 460 | end if; | |
| 461 | ||
| 462 | if Token = Tok_Arrow then | |
| 463 | Scan; -- Past arrow | |
| 464 | Set_Expression (Aspect, P_Expression); | |
| 465 | OK := False; | |
| 466 | ||
| 467 | elsif Token = Tok_Comma then | |
| 468 | OK := False; | |
| 469 | ||
| 470 | else | |
| 1c54829e AC |
471 | if Semicolon then |
| 472 | Resync_Past_Semicolon; | |
| 473 | end if; | |
| 474 | ||
| 0f1a6a0b AC |
475 | return; |
| 476 | end if; | |
| 477 | ||
| 478 | -- OK aspect scanned | |
| 479 | ||
| 480 | else | |
| 481 | Scan; -- past identifier | |
| 482 | ||
| 483 | -- Check for 'Class present | |
| 484 | ||
| 485 | if Token = Tok_Apostrophe then | |
| 486 | if not Class_Aspect_OK (A_Id) then | |
| 487 | Error_Msg_Node_1 := Identifier (Aspect); | |
| 488 | Error_Msg_SC ("aspect& does not permit attribute here"); | |
| 308e6f3a | 489 | Scan; -- past apostrophe |
| 0f1a6a0b AC |
490 | Scan; -- past presumed CLASS |
| 491 | OK := False; | |
| 492 | ||
| 493 | else | |
| 494 | Scan; -- past apostrophe | |
| 495 | ||
| 496 | if Token /= Tok_Identifier | |
| 497 | or else Token_Name /= Name_Class | |
| 498 | then | |
| 499 | Error_Msg_SC ("Class attribute expected here"); | |
| 500 | OK := False; | |
| 501 | ||
| 502 | if Token = Tok_Identifier then | |
| 503 | Scan; -- past identifier not CLASS | |
| 504 | end if; | |
| 811ef5ba RD |
505 | |
| 506 | else | |
| 507 | Scan; -- past CLASS | |
| 508 | Set_Class_Present (Aspect); | |
| 0f1a6a0b AC |
509 | end if; |
| 510 | end if; | |
| 511 | end if; | |
| 512 | ||
| 513 | -- Test case of missing aspect definition | |
| 514 | ||
| 1c54829e AC |
515 | if Token = Tok_Comma |
| 516 | or else Token = Tok_Semicolon | |
| b3aa0ca8 | 517 | |
| 1c54829e | 518 | then |
| b3aa0ca8 | 519 | -- or else (not Semicolon and then Token /= Tok_Arrow) |
| 0f1a6a0b | 520 | if Aspect_Argument (A_Id) /= Optional then |
| b3aa0ca8 | 521 | Error_Msg_Node_1 := Identifier (Aspect); |
| 0f1a6a0b AC |
522 | Error_Msg_AP ("aspect& requires an aspect definition"); |
| 523 | OK := False; | |
| b3aa0ca8 AC |
524 | |
| 525 | end if; | |
| 526 | ||
| 527 | elsif not Semicolon and then Token /= Tok_Arrow then | |
| 528 | if Aspect_Argument (A_Id) /= Optional then | |
| 529 | ||
| 530 | -- The name or expression may be there, but the arrow is | |
| 531 | -- missing. Skip to the end of the declaration. | |
| 532 | ||
| 533 | T_Arrow; | |
| 534 | Resync_To_Semicolon; | |
| 0f1a6a0b AC |
535 | end if; |
| 536 | ||
| 537 | -- Here we have an aspect definition | |
| 538 | ||
| 539 | else | |
| 540 | if Token = Tok_Arrow then | |
| 541 | Scan; -- past arrow | |
| 542 | else | |
| 543 | T_Arrow; | |
| 544 | OK := False; | |
| 545 | end if; | |
| 546 | ||
| 547 | if Aspect_Argument (A_Id) = Name then | |
| 548 | Set_Expression (Aspect, P_Name); | |
| 549 | else | |
| 550 | Set_Expression (Aspect, P_Expression); | |
| 551 | end if; | |
| 552 | end if; | |
| 553 | ||
| 554 | -- If OK clause scanned, add it to the list | |
| 555 | ||
| 556 | if OK then | |
| 557 | Append (Aspect, Aspects); | |
| 558 | end if; | |
| 559 | ||
| 560 | if Token = Tok_Comma then | |
| 561 | Scan; -- past comma | |
| 1c163178 | 562 | goto Continue; |
| 1c54829e | 563 | |
| 1c163178 AC |
564 | -- Recognize the case where a comma is missing between two |
| 565 | -- aspects, issue an error and proceed with next aspect. | |
| 1c54829e | 566 | |
| 1c163178 AC |
567 | elsif Token = Tok_Identifier |
| 568 | and then Get_Aspect_Id (Token_Name) /= No_Aspect | |
| 569 | then | |
| 570 | declare | |
| 571 | Scan_State : Saved_Scan_State; | |
| 572 | ||
| 573 | begin | |
| 574 | Save_Scan_State (Scan_State); | |
| 575 | Scan; -- past identifier | |
| 576 | ||
| 577 | if Token = Tok_Arrow then | |
| 578 | Restore_Scan_State (Scan_State); | |
| 579 | Error_Msg_AP -- CODEFIX | |
| 580 | ("|missing "","""); | |
| 581 | goto Continue; | |
| 1c54829e | 582 | |
| 1c163178 AC |
583 | else |
| 584 | Restore_Scan_State (Scan_State); | |
| 585 | end if; | |
| 586 | end; | |
| 587 | ||
| 588 | -- Recognize the case where a semicolon was mistyped for a comma | |
| 589 | -- between two aspects, issue an error and proceed with next | |
| 590 | -- aspect. | |
| 591 | ||
| 592 | elsif Token = Tok_Semicolon then | |
| 593 | declare | |
| 594 | Scan_State : Saved_Scan_State; | |
| 595 | ||
| 596 | begin | |
| 597 | Save_Scan_State (Scan_State); | |
| 598 | Scan; -- past semicolon | |
| 599 | ||
| 600 | if Token = Tok_Identifier | |
| 601 | and then Get_Aspect_Id (Token_Name) /= No_Aspect | |
| 602 | then | |
| 603 | Scan; -- past identifier | |
| 604 | ||
| 605 | if Token = Tok_Arrow then | |
| 606 | Restore_Scan_State (Scan_State); | |
| 607 | Error_Msg_SC -- CODEFIX | |
| 608 | ("|"";"" should be "","""); | |
| 609 | Scan; -- past semicolon | |
| 610 | goto Continue; | |
| 611 | ||
| 612 | else | |
| 613 | Restore_Scan_State (Scan_State); | |
| 614 | end if; | |
| 615 | ||
| 616 | else | |
| 617 | Restore_Scan_State (Scan_State); | |
| 618 | end if; | |
| 619 | end; | |
| 620 | end if; | |
| 621 | ||
| 622 | -- Must be terminator character | |
| 623 | ||
| 624 | if Semicolon then | |
| 625 | T_Semicolon; | |
| 0f1a6a0b | 626 | end if; |
| 1c163178 AC |
627 | |
| 628 | exit; | |
| 629 | ||
| 630 | <<Continue>> | |
| 631 | null; | |
| 0f1a6a0b AC |
632 | end if; |
| 633 | end loop; | |
| 634 | ||
| 9f90d123 | 635 | -- Here if aspects present |
| 0f1a6a0b AC |
636 | |
| 637 | if Is_Non_Empty_List (Aspects) then | |
| 9f90d123 AC |
638 | |
| 639 | -- If Decl is Empty, we just ignore the aspects (the caller in this | |
| 640 | -- case has always issued an appropriate error message). | |
| 641 | ||
| 642 | if Decl = Empty then | |
| 643 | null; | |
| 644 | ||
| 645 | -- If Decl is Error, we ignore the aspects, and issue a message | |
| 646 | ||
| 647 | elsif Decl = Error then | |
| 718deaf1 | 648 | Error_Msg ("aspect specifications not allowed here", Ptr); |
| 9f90d123 AC |
649 | |
| 650 | -- Here aspects are allowed, and we store them | |
| 651 | ||
| 718deaf1 AC |
652 | else |
| 653 | Set_Parent (Aspects, Decl); | |
| 654 | Set_Aspect_Specifications (Decl, Aspects); | |
| 655 | end if; | |
| 0f1a6a0b AC |
656 | end if; |
| 657 | end P_Aspect_Specifications; | |
| 658 | ||
| 19235870 RK |
659 | --------------------------------------------- |
| 660 | -- 13.4 Enumeration Representation Clause -- | |
| 661 | --------------------------------------------- | |
| 662 | ||
| 663 | -- Parsed by P_Representation_Clause (13.1) | |
| 664 | ||
| 665 | --------------------------------- | |
| 666 | -- 13.4 Enumeration Aggregate -- | |
| 667 | --------------------------------- | |
| 668 | ||
| 669 | -- Parsed by P_Representation_Clause (13.1) | |
| 670 | ||
| 671 | ------------------------------------------ | |
| 672 | -- 13.5.1 Record Representation Clause -- | |
| 673 | ------------------------------------------ | |
| 674 | ||
| 675 | -- Parsed by P_Representation_Clause (13.1) | |
| 676 | ||
| 677 | ------------------------------ | |
| 678 | -- 13.5.1 Mod Clause (I.8) -- | |
| 679 | ------------------------------ | |
| 680 | ||
| 681 | -- MOD_CLAUSE ::= at mod static_EXPRESSION; | |
| 682 | ||
| 683 | -- Note: in Ada 83, the expression must be a simple expression | |
| 684 | ||
| 685 | -- The caller has checked that the initial Token is AT | |
| 686 | ||
| 687 | -- Error recovery: cannot raise Error_Resync | |
| 688 | ||
| 689 | -- Note: the caller is responsible for setting the Pragmas_Before field | |
| 690 | ||
| 691 | function P_Mod_Clause return Node_Id is | |
| 692 | Mod_Node : Node_Id; | |
| 693 | Expr_Node : Node_Id; | |
| 694 | ||
| 695 | begin | |
| 696 | Mod_Node := New_Node (N_Mod_Clause, Token_Ptr); | |
| 697 | Scan; -- past AT | |
| 698 | T_Mod; | |
| 699 | Expr_Node := P_Expression_No_Right_Paren; | |
| 700 | Check_Simple_Expression_In_Ada_83 (Expr_Node); | |
| 701 | Set_Expression (Mod_Node, Expr_Node); | |
| 702 | TF_Semicolon; | |
| 703 | return Mod_Node; | |
| 704 | end P_Mod_Clause; | |
| 705 | ||
| 706 | ------------------------------ | |
| 707 | -- 13.5.1 Component Clause -- | |
| 708 | ------------------------------ | |
| 709 | ||
| 710 | -- COMPONENT_CLAUSE ::= | |
| 711 | -- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION | |
| 712 | -- range FIRST_BIT .. LAST_BIT; | |
| 713 | ||
| 714 | -- COMPONENT_CLAUSE_COMPONENT_NAME ::= | |
| 715 | -- component_DIRECT_NAME | |
| 716 | -- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR | |
| 717 | -- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR | |
| 718 | ||
| 719 | -- POSITION ::= static_EXPRESSION | |
| 720 | ||
| 721 | -- Note: in Ada 83, the expression must be a simple expression | |
| 722 | ||
| 723 | -- FIRST_BIT ::= static_SIMPLE_EXPRESSION | |
| 724 | -- LAST_BIT ::= static_SIMPLE_EXPRESSION | |
| 725 | ||
| 726 | -- Note: the AARM V2.0 grammar has an error at this point, it uses | |
| 727 | -- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT | |
| 728 | ||
| 729 | -- Error recovery: cannot raise Error_Resync | |
| 730 | ||
| 731 | function P_Component_Clause return Node_Id is | |
| 732 | Component_Node : Node_Id; | |
| 733 | Comp_Name : Node_Id; | |
| 734 | Expr_Node : Node_Id; | |
| 735 | ||
| 736 | begin | |
| 737 | Component_Node := New_Node (N_Component_Clause, Token_Ptr); | |
| 738 | Comp_Name := P_Name; | |
| 739 | ||
| 740 | if Nkind (Comp_Name) = N_Identifier | |
| 741 | or else Nkind (Comp_Name) = N_Attribute_Reference | |
| 742 | then | |
| 743 | Set_Component_Name (Component_Node, Comp_Name); | |
| 744 | else | |
| 745 | Error_Msg_N | |
| 746 | ("component name must be direct name or attribute", Comp_Name); | |
| 747 | Set_Component_Name (Component_Node, Error); | |
| 748 | end if; | |
| 749 | ||
| 750 | Set_Sloc (Component_Node, Token_Ptr); | |
| 751 | T_At; | |
| 752 | Expr_Node := P_Expression_No_Right_Paren; | |
| 753 | Check_Simple_Expression_In_Ada_83 (Expr_Node); | |
| 754 | Set_Position (Component_Node, Expr_Node); | |
| 755 | T_Range; | |
| 756 | Expr_Node := P_Expression_No_Right_Paren; | |
| 757 | Check_Simple_Expression_In_Ada_83 (Expr_Node); | |
| 758 | Set_First_Bit (Component_Node, Expr_Node); | |
| 759 | T_Dot_Dot; | |
| 760 | Expr_Node := P_Expression_No_Right_Paren; | |
| 761 | Check_Simple_Expression_In_Ada_83 (Expr_Node); | |
| 762 | Set_Last_Bit (Component_Node, Expr_Node); | |
| 763 | TF_Semicolon; | |
| 764 | return Component_Node; | |
| 765 | end P_Component_Clause; | |
| 766 | ||
| 767 | ---------------------- | |
| 768 | -- 13.5.1 Position -- | |
| 769 | ---------------------- | |
| 770 | ||
| 771 | -- Parsed by P_Component_Clause (13.5.1) | |
| 772 | ||
| 773 | ----------------------- | |
| 774 | -- 13.5.1 First Bit -- | |
| 775 | ----------------------- | |
| 776 | ||
| 777 | -- Parsed by P_Component_Clause (13.5.1) | |
| 778 | ||
| 779 | ---------------------- | |
| 780 | -- 13.5.1 Last Bit -- | |
| 781 | ---------------------- | |
| 782 | ||
| 783 | -- Parsed by P_Component_Clause (13.5.1) | |
| 784 | ||
| 785 | -------------------------- | |
| 786 | -- 13.8 Code Statement -- | |
| 787 | -------------------------- | |
| 788 | ||
| 789 | -- CODE_STATEMENT ::= QUALIFIED_EXPRESSION | |
| 790 | ||
| 791 | -- On entry the caller has scanned the SUBTYPE_MARK (passed in as the | |
| 792 | -- single argument, and the scan points to the apostrophe. | |
| 793 | ||
| 794 | -- Error recovery: can raise Error_Resync | |
| 795 | ||
| 796 | function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is | |
| 797 | Node1 : Node_Id; | |
| 798 | ||
| 799 | begin | |
| 800 | Scan; -- past apostrophe | |
| 801 | ||
| 802 | -- If left paren, then we have a possible code statement | |
| 803 | ||
| 804 | if Token = Tok_Left_Paren then | |
| 805 | Node1 := New_Node (N_Code_Statement, Sloc (Subtype_Mark)); | |
| 806 | Set_Expression (Node1, P_Qualified_Expression (Subtype_Mark)); | |
| 807 | TF_Semicolon; | |
| 808 | return Node1; | |
| 809 | ||
| 810 | -- Otherwise we have an illegal range attribute. Note that P_Name | |
| 811 | -- ensures that Token = Tok_Range is the only possibility left here. | |
| 812 | ||
| 813 | else -- Token = Tok_Range | |
| 814 | Error_Msg_SC ("RANGE attribute illegal here!"); | |
| 815 | raise Error_Resync; | |
| 816 | end if; | |
| 817 | ||
| 818 | end P_Code_Statement; | |
| 819 | ||
| 820 | end Ch13; |