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