1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- P A R . L O A D -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- 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- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 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 -- 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. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26-- The Par.Load procedure loads all units that are definitely required before 27-- it makes any sense at all to proceed with semantic analysis, including 28-- with'ed units, corresponding specs for bodies, parents of child specs, 29-- and parents of subunits. All these units are loaded and pointers installed 30-- in the tree as described in the spec of package Lib. 31 32with Fname.UF; use Fname.UF; 33with Lib.Load; use Lib.Load; 34with Namet.Sp; use Namet.Sp; 35with Uname; use Uname; 36with Osint; use Osint; 37with Sinput.L; use Sinput.L; 38with Stylesw; use Stylesw; 39with Validsw; use Validsw; 40 41with GNAT.Spelling_Checker; use GNAT.Spelling_Checker; 42 43separate (Par) 44procedure Load is 45 46 File_Name : File_Name_Type; 47 -- Name of file for current unit, derived from unit name 48 49 Cur_Unum : constant Unit_Number_Type := Current_Source_Unit; 50 -- Unit number of unit that we just finished parsing. Note that we need 51 -- to capture this, because Source_Unit will change as we parse new 52 -- source files in the multiple main source file case. 53 54 Curunit : constant Node_Id := Cunit (Cur_Unum); 55 -- Compilation unit node for current compilation unit 56 57 Loc : Source_Ptr := Sloc (Curunit); 58 -- Source location for compilation unit node 59 60 Save_Style_Check : Boolean; 61 Save_Style_Checks : Style_Check_Options; 62 -- Save style check so it can be restored later 63 64 Save_Validity_Check : Boolean; 65 Save_Validity_Checks : Validity_Check_Options; 66 -- Save validity check so it can be restored later 67 68 With_Cunit : Node_Id; 69 -- Compilation unit node for withed unit 70 71 Context_Node : Node_Id; 72 -- Next node in context items list 73 74 With_Node : Node_Id; 75 -- N_With_Clause node 76 77 Spec_Name : Unit_Name_Type; 78 -- Unit name of required spec 79 80 Body_Name : Unit_Name_Type; 81 -- Unit name of corresponding body 82 83 Unum : Unit_Number_Type; 84 -- Unit number of loaded unit 85 86 Limited_With_Found : Boolean := False; 87 -- We load the context items in two rounds: the first round handles normal 88 -- withed units and the second round handles Ada 2005 limited-withed units. 89 -- This is required to allow the low-level circuitry that detects circular 90 -- dependencies of units the correct notification of errors (see comment 91 -- bellow). This variable is used to indicate that the second round is 92 -- required. 93 94 function Same_File_Name_Except_For_Case 95 (Expected_File_Name : File_Name_Type; 96 Actual_File_Name : File_Name_Type) return Boolean; 97 -- Given an actual file name and an expected file name (the latter being 98 -- derived from the unit name), determine if they are the same except for 99 -- possibly different casing of letters. 100 101 ------------------------------------ 102 -- Same_File_Name_Except_For_Case -- 103 ------------------------------------ 104 105 function Same_File_Name_Except_For_Case 106 (Expected_File_Name : File_Name_Type; 107 Actual_File_Name : File_Name_Type) return Boolean 108 is 109 begin 110 Get_Name_String (Actual_File_Name); 111 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); 112 113 declare 114 Lower_Case_Actual_File_Name : String (1 .. Name_Len); 115 116 begin 117 Lower_Case_Actual_File_Name := Name_Buffer (1 .. Name_Len); 118 Get_Name_String (Expected_File_Name); 119 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); 120 return Lower_Case_Actual_File_Name = Name_Buffer (1 .. Name_Len); 121 end; 122 123 end Same_File_Name_Except_For_Case; 124 125-- Start of processing for Load 126 127begin 128 -- Don't do any loads if we already had a fatal error 129 130 if Fatal_Error (Cur_Unum) then 131 return; 132 end if; 133 134 Save_Style_Check_Options (Save_Style_Checks); 135 Save_Style_Check := Opt.Style_Check; 136 137 Save_Validity_Check_Options (Save_Validity_Checks); 138 Save_Validity_Check := Opt.Validity_Checks_On; 139 140 -- If main unit, set Main_Unit_Entity (this will get overwritten if 141 -- the main unit has a separate spec, that happens later on in Load) 142 143 if Cur_Unum = Main_Unit then 144 Main_Unit_Entity := Cunit_Entity (Main_Unit); 145 end if; 146 147 -- If we have no unit name, things are seriously messed up by previous 148 -- errors, and we should not try to continue compilation. 149 150 if Unit_Name (Cur_Unum) = No_Unit_Name then 151 raise Unrecoverable_Error; 152 end if; 153 154 -- Next step, make sure that the unit name matches the file name 155 -- and issue a warning message if not. We only output this for the 156 -- main unit, since for other units it is more serious and is 157 -- caught in a separate test below. We also inhibit the message in 158 -- multiple unit per file mode, because in this case the relation 159 -- between file name and unit name is broken. 160 161 File_Name := 162 Get_File_Name 163 (Unit_Name (Cur_Unum), 164 Subunit => Nkind (Unit (Cunit (Cur_Unum))) = N_Subunit); 165 166 if Cur_Unum = Main_Unit 167 and then Multiple_Unit_Index = 0 168 and then File_Name /= Unit_File_Name (Cur_Unum) 169 and then (File_Names_Case_Sensitive 170 or not Same_File_Name_Except_For_Case 171 (File_Name, Unit_File_Name (Cur_Unum))) 172 then 173 Error_Msg_File_1 := File_Name; 174 Error_Msg 175 ("??file name does not match unit name, should be{", Sloc (Curunit)); 176 end if; 177 178 -- For units other than the main unit, the expected unit name is set and 179 -- must be the same as the actual unit name, or we are in big trouble, and 180 -- abandon the compilation since there are situations where this really 181 -- gets us into bad trouble (e.g. some subunit situations). 182 183 if Cur_Unum /= Main_Unit 184 and then Expected_Unit (Cur_Unum) /= Unit_Name (Cur_Unum) 185 then 186 Loc := Error_Location (Cur_Unum); 187 Error_Msg_File_1 := Unit_File_Name (Cur_Unum); 188 Get_Name_String (Error_Msg_File_1); 189 190 -- Check for predefined file case 191 192 if Name_Len > 1 193 and then Name_Buffer (2) = '-' 194 and then (Name_Buffer (1) = 'a' 195 or else 196 Name_Buffer (1) = 's' 197 or else 198 Name_Buffer (1) = 'i' 199 or else 200 Name_Buffer (1) = 'g') 201 then 202 declare 203 Expect_Name : constant Unit_Name_Type := Expected_Unit (Cur_Unum); 204 Actual_Name : constant Unit_Name_Type := Unit_Name (Cur_Unum); 205 206 begin 207 Error_Msg_Unit_1 := Expect_Name; 208 Error_Msg -- CODEFIX 209 ("$$ is not a predefined library unit!", Loc); 210 211 -- In the predefined file case, we know the user did not 212 -- construct their own package, but we got the wrong one. 213 -- This means that the name supplied by the user crunched 214 -- to something we recognized, but then the file did not 215 -- contain the unit expected. Most likely this is due to 216 -- a misspelling, e.g. 217 218 -- with Ada.Calender; 219 220 -- This crunches to a-calend, which indeed contains the unit 221 -- Ada.Calendar, and we can diagnose the misspelling. This 222 -- is a simple heuristic, but it catches many common cases 223 -- of misspelling of predefined unit names without needing 224 -- a full list of them. 225 226 -- Before actually issuing the message, we will check that the 227 -- unit name is indeed a plausible misspelling of the one we got. 228 229 if Is_Bad_Spelling_Of 230 (Name_Id (Expect_Name), Name_Id (Actual_Name)) 231 then 232 Error_Msg_Unit_1 := Actual_Name; 233 Error_Msg -- CODEFIX 234 ("possible misspelling of $$!", Loc); 235 end if; 236 end; 237 238 -- Non-predefined file name case. In this case we generate a message 239 -- and then we quit, because we are in big trouble, and if we try 240 -- to continue compilation, we get into some nasty situations 241 -- (for example in some subunit cases). 242 243 else 244 Error_Msg ("file { does not contain expected unit!", Loc); 245 Error_Msg_Unit_1 := Expected_Unit (Cur_Unum); 246 Error_Msg ("\\expected unit $!", Loc); 247 Error_Msg_Unit_1 := Unit_Name (Cur_Unum); 248 Error_Msg ("\\found unit $!", Loc); 249 end if; 250 251 -- In both cases, remove the unit if it is the last unit (which it 252 -- normally (always?) will be) so that it is out of the way later. 253 254 Remove_Unit (Cur_Unum); 255 end if; 256 257 -- If current unit is a body, load its corresponding spec 258 259 if Nkind (Unit (Curunit)) = N_Package_Body 260 or else Nkind (Unit (Curunit)) = N_Subprogram_Body 261 then 262 Spec_Name := Get_Spec_Name (Unit_Name (Cur_Unum)); 263 Unum := 264 Load_Unit 265 (Load_Name => Spec_Name, 266 Required => False, 267 Subunit => False, 268 Error_Node => Curunit, 269 Corr_Body => Cur_Unum, 270 PMES => (Cur_Unum = Main_Unit)); 271 272 -- If we successfully load the unit, then set the spec/body pointers. 273 -- Once again note that if the loaded unit has a fatal error, Load will 274 -- have set our Fatal_Error flag to propagate this condition. 275 276 if Unum /= No_Unit then 277 Set_Library_Unit (Curunit, Cunit (Unum)); 278 Set_Library_Unit (Cunit (Unum), Curunit); 279 280 -- If this is a separate spec for the main unit, then we reset 281 -- Main_Unit_Entity to point to the entity for this separate spec 282 -- and this is also where we generate the SCO's for this spec. 283 284 if Cur_Unum = Main_Unit then 285 Main_Unit_Entity := Cunit_Entity (Unum); 286 287 if Generate_SCO then 288 SCO_Record (Unum); 289 end if; 290 end if; 291 292 -- If we don't find the spec, then if we have a subprogram body, we 293 -- are still OK, we just have a case of a body acting as its own spec 294 295 elsif Nkind (Unit (Curunit)) = N_Subprogram_Body then 296 Set_Acts_As_Spec (Curunit, True); 297 Set_Library_Unit (Curunit, Curunit); 298 299 -- Otherwise we do have an error, repeat the load request for the spec 300 -- with Required set True to generate an appropriate error message. 301 302 else 303 Unum := 304 Load_Unit 305 (Load_Name => Spec_Name, 306 Required => True, 307 Subunit => False, 308 Error_Node => Curunit); 309 return; 310 end if; 311 312 -- If current unit is a child unit spec, load its parent. If the child unit 313 -- is loaded through a limited with, the parent must be as well. 314 315 elsif Nkind (Unit (Curunit)) = N_Package_Declaration 316 or else Nkind (Unit (Curunit)) = N_Subprogram_Declaration 317 or else Nkind (Unit (Curunit)) in N_Generic_Declaration 318 or else Nkind (Unit (Curunit)) in N_Generic_Instantiation 319 or else Nkind (Unit (Curunit)) in N_Renaming_Declaration 320 then 321 -- Turn style and validity checks off for parent unit 322 323 if not GNAT_Mode then 324 Reset_Style_Check_Options; 325 Reset_Validity_Check_Options; 326 end if; 327 328 Spec_Name := Get_Parent_Spec_Name (Unit_Name (Cur_Unum)); 329 330 if Spec_Name /= No_Unit_Name then 331 Unum := 332 Load_Unit 333 (Load_Name => Spec_Name, 334 Required => True, 335 Subunit => False, 336 Error_Node => Curunit); 337 338 if Unum /= No_Unit then 339 Set_Parent_Spec (Unit (Curunit), Cunit (Unum)); 340 end if; 341 end if; 342 343 -- If current unit is a subunit, then load its parent body 344 345 elsif Nkind (Unit (Curunit)) = N_Subunit then 346 Body_Name := Get_Parent_Body_Name (Unit_Name (Cur_Unum)); 347 Unum := 348 Load_Unit 349 (Load_Name => Body_Name, 350 Required => True, 351 Subunit => False, 352 Error_Node => Name (Unit (Curunit))); 353 354 if Unum /= No_Unit then 355 Set_Library_Unit (Curunit, Cunit (Unum)); 356 end if; 357 end if; 358 359 -- Now we load with'ed units, with style/validity checks turned off 360 361 if not GNAT_Mode then 362 Reset_Style_Check_Options; 363 Reset_Validity_Check_Options; 364 end if; 365 366 -- Load the context items in two rounds: the first round handles normal 367 -- withed units and the second round handles Ada 2005 limited-withed units. 368 -- This is required to allow the low-level circuitry that detects circular 369 -- dependencies of units the correct notification of the following error: 370 371 -- limited with D; 372 -- with D; with C; 373 -- package C is ... package D is ... 374 375 for Round in 1 .. 2 loop 376 Context_Node := First (Context_Items (Curunit)); 377 while Present (Context_Node) loop 378 379 -- During the first round we check if there is some limited-with 380 -- context clause; otherwise the second round will be skipped 381 382 if Nkind (Context_Node) = N_With_Clause 383 and then Round = 1 384 and then Limited_Present (Context_Node) 385 then 386 Limited_With_Found := True; 387 end if; 388 389 if Nkind (Context_Node) = N_With_Clause 390 and then ((Round = 1 and then not Limited_Present (Context_Node)) 391 or else 392 (Round = 2 and then Limited_Present (Context_Node))) 393 then 394 With_Node := Context_Node; 395 Spec_Name := Get_Unit_Name (With_Node); 396 397 Unum := 398 Load_Unit 399 (Load_Name => Spec_Name, 400 Required => False, 401 Subunit => False, 402 Error_Node => With_Node, 403 Renamings => True, 404 With_Node => Context_Node); 405 406 -- If we find the unit, then set spec pointer in the N_With_Clause 407 -- to point to the compilation unit for the spec. Remember that 408 -- the Load routine itself sets our Fatal_Error flag if the loaded 409 -- unit gets a fatal error, so we don't need to worry about that. 410 411 if Unum /= No_Unit then 412 Set_Library_Unit (With_Node, Cunit (Unum)); 413 414 -- If the spec isn't found, then try finding the corresponding 415 -- body, since it is possible that we have a subprogram body 416 -- that is acting as a spec (since no spec is present). 417 418 else 419 Body_Name := Get_Body_Name (Spec_Name); 420 Unum := 421 Load_Unit 422 (Load_Name => Body_Name, 423 Required => False, 424 Subunit => False, 425 Error_Node => With_Node, 426 Renamings => True); 427 428 -- If we got a subprogram body, then mark that we are using 429 -- the body as a spec in the file table, and set the spec 430 -- pointer in the N_With_Clause to point to the body entity. 431 432 if Unum /= No_Unit 433 and then Nkind (Unit (Cunit (Unum))) = N_Subprogram_Body 434 then 435 With_Cunit := Cunit (Unum); 436 Set_Library_Unit (With_Node, With_Cunit); 437 Set_Acts_As_Spec (With_Cunit, True); 438 Set_Library_Unit (With_Cunit, With_Cunit); 439 440 -- If we couldn't find the body, or if it wasn't a body spec 441 -- then we are in trouble. We make one more call to Load to 442 -- require the spec. We know it will fail of course, the 443 -- purpose is to generate the required error message (we prefer 444 -- that this message refer to the missing spec, not the body) 445 446 else 447 Unum := 448 Load_Unit 449 (Load_Name => Spec_Name, 450 Required => True, 451 Subunit => False, 452 Error_Node => With_Node, 453 Renamings => True); 454 455 -- Here we create a dummy package unit for the missing unit 456 457 Unum := Create_Dummy_Package_Unit (With_Node, Spec_Name); 458 Set_Library_Unit (With_Node, Cunit (Unum)); 459 end if; 460 end if; 461 end if; 462 463 Next (Context_Node); 464 end loop; 465 466 exit when not Limited_With_Found; 467 end loop; 468 469 -- Restore style/validity check mode for main unit 470 471 Set_Style_Check_Options (Save_Style_Checks); 472 Opt.Style_Check := Save_Style_Check; 473 Set_Validity_Check_Options (Save_Validity_Checks); 474 Opt.Validity_Checks_On := Save_Validity_Check; 475end Load; 476