| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- P A R . L O A D -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- |
| -- for more details. You should have received a copy of the GNU General -- |
| -- Public License distributed with GNAT; see file COPYING3. If not, go to -- |
| -- http://www.gnu.org/licenses for a complete copy of the license. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| -- The Par.Load procedure loads all units that are definitely required before |
| -- it makes any sense at all to proceed with semantic analysis, including |
| -- with'ed units, corresponding specs for bodies, parents of child specs, |
| -- and parents of subunits. All these units are loaded and pointers installed |
| -- in the tree as described in the spec of package Lib. |
| |
| with Fname.UF; use Fname.UF; |
| with Lib.Load; use Lib.Load; |
| with Namet.Sp; use Namet.Sp; |
| with Uname; use Uname; |
| with Osint; use Osint; |
| with Sinput.L; use Sinput.L; |
| with Stylesw; use Stylesw; |
| with Validsw; use Validsw; |
| |
| with GNAT.Spelling_Checker; use GNAT.Spelling_Checker; |
| |
| separate (Par) |
| procedure Load is |
| |
| File_Name : File_Name_Type; |
| -- Name of file for current unit, derived from unit name |
| |
| Cur_Unum : constant Unit_Number_Type := Current_Source_Unit; |
| -- Unit number of unit that we just finished parsing. Note that we need |
| -- to capture this, because Source_Unit will change as we parse new |
| -- source files in the multiple main source file case. |
| |
| Curunit : constant Node_Id := Cunit (Cur_Unum); |
| -- Compilation unit node for current compilation unit |
| |
| Loc : Source_Ptr := Sloc (Curunit); |
| -- Source location for compilation unit node |
| |
| Save_Style_Check : Boolean; |
| Save_Style_Checks : Style_Check_Options; |
| -- Save style check so it can be restored later |
| |
| Save_Validity_Check : Boolean; |
| Save_Validity_Checks : Validity_Check_Options; |
| -- Save validity check so it can be restored later |
| |
| With_Cunit : Node_Id; |
| -- Compilation unit node for withed unit |
| |
| Context_Node : Node_Id; |
| -- Next node in context items list |
| |
| With_Node : Node_Id; |
| -- N_With_Clause node |
| |
| Spec_Name : Unit_Name_Type; |
| -- Unit name of required spec |
| |
| Body_Name : Unit_Name_Type; |
| -- Unit name of corresponding body |
| |
| Unum : Unit_Number_Type; |
| -- Unit number of loaded unit |
| |
| Limited_With_Found : Boolean := False; |
| -- We load the context items in two rounds: the first round handles normal |
| -- withed units and the second round handles Ada 2005 limited-withed units. |
| -- This is required to allow the low-level circuitry that detects circular |
| -- dependencies of units the correct notification of errors (see comment |
| -- bellow). This variable is used to indicate that the second round is |
| -- required. |
| |
| function Same_File_Name_Except_For_Case |
| (Expected_File_Name : File_Name_Type; |
| Actual_File_Name : File_Name_Type) return Boolean; |
| -- Given an actual file name and an expected file name (the latter being |
| -- derived from the unit name), determine if they are the same except for |
| -- possibly different casing of letters. |
| |
| ------------------------------------ |
| -- Same_File_Name_Except_For_Case -- |
| ------------------------------------ |
| |
| function Same_File_Name_Except_For_Case |
| (Expected_File_Name : File_Name_Type; |
| Actual_File_Name : File_Name_Type) return Boolean |
| is |
| begin |
| Get_Name_String (Actual_File_Name); |
| Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); |
| |
| declare |
| Lower_Case_Actual_File_Name : String (1 .. Name_Len); |
| |
| begin |
| Lower_Case_Actual_File_Name := Name_Buffer (1 .. Name_Len); |
| Get_Name_String (Expected_File_Name); |
| Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); |
| return Lower_Case_Actual_File_Name = Name_Buffer (1 .. Name_Len); |
| end; |
| |
| end Same_File_Name_Except_For_Case; |
| |
| -- Start of processing for Load |
| |
| begin |
| -- Don't do any loads if we already had a fatal error |
| |
| if Fatal_Error (Cur_Unum) = Error_Detected then |
| return; |
| end if; |
| |
| Save_Style_Check_Options (Save_Style_Checks); |
| Save_Style_Check := Opt.Style_Check; |
| |
| Save_Validity_Check_Options (Save_Validity_Checks); |
| Save_Validity_Check := Opt.Validity_Checks_On; |
| |
| -- If main unit, set Main_Unit_Entity (this will get overwritten if |
| -- the main unit has a separate spec, that happens later on in Load) |
| |
| if Cur_Unum = Main_Unit then |
| Main_Unit_Entity := Cunit_Entity (Main_Unit); |
| end if; |
| |
| -- If we have no unit name, things are seriously messed up by previous |
| -- errors, and we should not try to continue compilation. |
| |
| if Unit_Name (Cur_Unum) = No_Unit_Name then |
| raise Unrecoverable_Error; |
| end if; |
| |
| -- Next step, make sure that the unit name matches the file name |
| -- and issue a warning message if not. We only output this for the |
| -- main unit, since for other units it is more serious and is |
| -- caught in a separate test below. We also inhibit the message in |
| -- multiple unit per file mode, because in this case the relation |
| -- between file name and unit name is broken. |
| |
| File_Name := |
| Get_File_Name |
| (Unit_Name (Cur_Unum), |
| Subunit => Nkind (Unit (Cunit (Cur_Unum))) = N_Subunit); |
| |
| if Cur_Unum = Main_Unit |
| and then Multiple_Unit_Index = 0 |
| and then File_Name /= Unit_File_Name (Cur_Unum) |
| and then (File_Names_Case_Sensitive |
| or not Same_File_Name_Except_For_Case |
| (File_Name, Unit_File_Name (Cur_Unum))) |
| then |
| Error_Msg_File_1 := File_Name; |
| Error_Msg |
| ("??file name does not match unit name, should be{", Sloc (Curunit)); |
| end if; |
| |
| -- For units other than the main unit, the expected unit name is set and |
| -- must be the same as the actual unit name, or we are in big trouble, and |
| -- abandon the compilation since there are situations where this really |
| -- gets us into bad trouble (e.g. some subunit situations). |
| |
| if Cur_Unum /= Main_Unit |
| and then Expected_Unit (Cur_Unum) /= Unit_Name (Cur_Unum) |
| then |
| Loc := Error_Location (Cur_Unum); |
| Error_Msg_File_1 := Unit_File_Name (Cur_Unum); |
| Get_Name_String (Error_Msg_File_1); |
| |
| -- Check for predefined file case |
| |
| if Name_Len > 1 |
| and then Name_Buffer (2) = '-' |
| and then (Name_Buffer (1) = 'a' |
| or else |
| Name_Buffer (1) = 's' |
| or else |
| Name_Buffer (1) = 'i' |
| or else |
| Name_Buffer (1) = 'g') |
| then |
| declare |
| Expect_Name : constant Unit_Name_Type := Expected_Unit (Cur_Unum); |
| Actual_Name : constant Unit_Name_Type := Unit_Name (Cur_Unum); |
| |
| begin |
| Error_Msg_Unit_1 := Expect_Name; |
| Error_Msg -- CODEFIX |
| ("$$ is not a predefined library unit!", Loc); |
| |
| -- In the predefined file case, we know the user did not |
| -- construct their own package, but we got the wrong one. |
| -- This means that the name supplied by the user crunched |
| -- to something we recognized, but then the file did not |
| -- contain the unit expected. Most likely this is due to |
| -- a misspelling, e.g. |
| |
| -- with Ada.Calender; |
| |
| -- This crunches to a-calend, which indeed contains the unit |
| -- Ada.Calendar, and we can diagnose the misspelling. This |
| -- is a simple heuristic, but it catches many common cases |
| -- of misspelling of predefined unit names without needing |
| -- a full list of them. |
| |
| -- Before actually issuing the message, we will check that the |
| -- unit name is indeed a plausible misspelling of the one we got. |
| |
| if Is_Bad_Spelling_Of |
| (Name_Id (Expect_Name), Name_Id (Actual_Name)) |
| then |
| Error_Msg_Unit_1 := Actual_Name; |
| Error_Msg -- CODEFIX |
| ("possible misspelling of $$!", Loc); |
| end if; |
| end; |
| |
| -- Non-predefined file name case. In this case we generate a message |
| -- and then we quit, because we are in big trouble, and if we try |
| -- to continue compilation, we get into some nasty situations |
| -- (for example in some subunit cases). |
| |
| else |
| Error_Msg ("file { does not contain expected unit!", Loc); |
| Error_Msg_Unit_1 := Expected_Unit (Cur_Unum); |
| Error_Msg ("\\expected unit $!", Loc); |
| Error_Msg_Unit_1 := Unit_Name (Cur_Unum); |
| Error_Msg ("\\found unit $!", Loc); |
| end if; |
| |
| -- In both cases, remove the unit if it is the last unit (which it |
| -- normally (always?) will be) so that it is out of the way later. |
| |
| Remove_Unit (Cur_Unum); |
| end if; |
| |
| -- If current unit is a body, load its corresponding spec |
| |
| if Nkind (Unit (Curunit)) = N_Package_Body |
| or else Nkind (Unit (Curunit)) = N_Subprogram_Body |
| then |
| Spec_Name := Get_Spec_Name (Unit_Name (Cur_Unum)); |
| Unum := |
| Load_Unit |
| (Load_Name => Spec_Name, |
| Required => False, |
| Subunit => False, |
| Error_Node => Curunit, |
| Corr_Body => Cur_Unum, |
| PMES => (Cur_Unum = Main_Unit)); |
| |
| -- If we successfully load the unit, then set the spec/body pointers. |
| -- Once again note that if the loaded unit has a fatal error, Load will |
| -- have set our Fatal_Error flag to propagate this condition. |
| |
| if Unum /= No_Unit then |
| Set_Library_Unit (Curunit, Cunit (Unum)); |
| Set_Library_Unit (Cunit (Unum), Curunit); |
| |
| -- If this is a separate spec for the main unit, then we reset |
| -- Main_Unit_Entity to point to the entity for this separate spec |
| -- and this is also where we generate the SCO's for this spec. |
| |
| if Cur_Unum = Main_Unit then |
| Main_Unit_Entity := Cunit_Entity (Unum); |
| |
| if Generate_SCO then |
| SCO_Record_Raw (Unum); |
| end if; |
| end if; |
| |
| -- If we don't find the spec, then if we have a subprogram body, we |
| -- are still OK, we just have a case of a body acting as its own spec |
| |
| elsif Nkind (Unit (Curunit)) = N_Subprogram_Body then |
| Set_Acts_As_Spec (Curunit, True); |
| Set_Library_Unit (Curunit, Curunit); |
| |
| -- Otherwise we do have an error, repeat the load request for the spec |
| -- with Required set True to generate an appropriate error message. |
| |
| else |
| Unum := |
| Load_Unit |
| (Load_Name => Spec_Name, |
| Required => True, |
| Subunit => False, |
| Error_Node => Curunit); |
| return; |
| end if; |
| |
| -- If current unit is a child unit spec, load its parent. If the child unit |
| -- is loaded through a limited with, the parent must be as well. |
| |
| elsif Nkind (Unit (Curunit)) = N_Package_Declaration |
| or else Nkind (Unit (Curunit)) = N_Subprogram_Declaration |
| or else Nkind (Unit (Curunit)) in N_Generic_Declaration |
| or else Nkind (Unit (Curunit)) in N_Generic_Instantiation |
| or else Nkind (Unit (Curunit)) in N_Renaming_Declaration |
| then |
| -- Turn style and validity checks off for parent unit |
| |
| if not GNAT_Mode then |
| Reset_Style_Check_Options; |
| Reset_Validity_Check_Options; |
| end if; |
| |
| Spec_Name := Get_Parent_Spec_Name (Unit_Name (Cur_Unum)); |
| |
| if Spec_Name /= No_Unit_Name then |
| Unum := |
| Load_Unit |
| (Load_Name => Spec_Name, |
| Required => True, |
| Subunit => False, |
| Error_Node => Curunit); |
| |
| if Unum /= No_Unit then |
| Set_Parent_Spec (Unit (Curunit), Cunit (Unum)); |
| end if; |
| end if; |
| |
| -- If current unit is a subunit, then load its parent body |
| |
| elsif Nkind (Unit (Curunit)) = N_Subunit then |
| Body_Name := Get_Parent_Body_Name (Unit_Name (Cur_Unum)); |
| Unum := |
| Load_Unit |
| (Load_Name => Body_Name, |
| Required => True, |
| Subunit => False, |
| Error_Node => Name (Unit (Curunit))); |
| |
| if Unum /= No_Unit then |
| Set_Library_Unit (Curunit, Cunit (Unum)); |
| end if; |
| end if; |
| |
| -- Now we load with'ed units, with style/validity checks turned off |
| |
| if not GNAT_Mode then |
| Reset_Style_Check_Options; |
| Reset_Validity_Check_Options; |
| end if; |
| |
| -- Load the context items in two rounds: the first round handles normal |
| -- withed units and the second round handles Ada 2005 limited-withed units. |
| -- This is required to allow the low-level circuitry that detects circular |
| -- dependencies of units the correct notification of the following error: |
| |
| -- limited with D; |
| -- with D; with C; |
| -- package C is ... package D is ... |
| |
| for Round in 1 .. 2 loop |
| Context_Node := First (Context_Items (Curunit)); |
| while Present (Context_Node) loop |
| |
| -- During the first round we check if there is some limited-with |
| -- context clause; otherwise the second round will be skipped |
| |
| if Nkind (Context_Node) = N_With_Clause |
| and then Round = 1 |
| and then Limited_Present (Context_Node) |
| then |
| Limited_With_Found := True; |
| end if; |
| |
| if Nkind (Context_Node) = N_With_Clause |
| and then ((Round = 1 and then not Limited_Present (Context_Node)) |
| or else |
| (Round = 2 and then Limited_Present (Context_Node))) |
| then |
| With_Node := Context_Node; |
| Spec_Name := Get_Unit_Name (With_Node); |
| |
| Unum := |
| Load_Unit |
| (Load_Name => Spec_Name, |
| Required => False, |
| Subunit => False, |
| Error_Node => With_Node, |
| Renamings => True, |
| With_Node => Context_Node); |
| |
| -- If we find the unit, then set spec pointer in the N_With_Clause |
| -- to point to the compilation unit for the spec. Remember that |
| -- the Load routine itself sets our Fatal_Error flag if the loaded |
| -- unit gets a fatal error, so we don't need to worry about that. |
| |
| if Unum /= No_Unit then |
| Set_Library_Unit (With_Node, Cunit (Unum)); |
| |
| -- If the spec isn't found, then try finding the corresponding |
| -- body, since it is possible that we have a subprogram body |
| -- that is acting as a spec (since no spec is present). |
| |
| else |
| Body_Name := Get_Body_Name (Spec_Name); |
| Unum := |
| Load_Unit |
| (Load_Name => Body_Name, |
| Required => False, |
| Subunit => False, |
| Error_Node => With_Node, |
| Renamings => True); |
| |
| -- If we got a subprogram body, then mark that we are using |
| -- the body as a spec in the file table, and set the spec |
| -- pointer in the N_With_Clause to point to the body entity. |
| |
| if Unum /= No_Unit |
| and then Nkind (Unit (Cunit (Unum))) = N_Subprogram_Body |
| then |
| With_Cunit := Cunit (Unum); |
| Set_Library_Unit (With_Node, With_Cunit); |
| Set_Acts_As_Spec (With_Cunit, True); |
| Set_Library_Unit (With_Cunit, With_Cunit); |
| |
| -- If we couldn't find the body, or if it wasn't a body spec |
| -- then we are in trouble. We make one more call to Load to |
| -- require the spec. We know it will fail of course, the |
| -- purpose is to generate the required error message (we prefer |
| -- that this message refer to the missing spec, not the body) |
| |
| else |
| Unum := |
| Load_Unit |
| (Load_Name => Spec_Name, |
| Required => True, |
| Subunit => False, |
| Error_Node => With_Node, |
| Renamings => True); |
| |
| -- Here we create a dummy package unit for the missing unit |
| |
| Unum := Create_Dummy_Package_Unit (With_Node, Spec_Name); |
| Set_Library_Unit (With_Node, Cunit (Unum)); |
| end if; |
| end if; |
| end if; |
| |
| Next (Context_Node); |
| end loop; |
| |
| exit when not Limited_With_Found; |
| end loop; |
| |
| -- Restore style/validity check mode for main unit |
| |
| Set_Style_Check_Options (Save_Style_Checks); |
| Opt.Style_Check := Save_Style_Check; |
| Set_Validity_Check_Options (Save_Validity_Checks); |
| Opt.Validity_Checks_On := Save_Validity_Check; |
| end Load; |
