with Fname; use Fname;
with Fname.UF; use Fname.UF;
with Lib.Load; use Lib.Load;
with Uname; use Uname;
with Namet; use Namet;
with Casing; use Casing;
with Opt; use Opt;
with Osint; use Osint;
with Sinput.L; use Sinput.L;
with Stylesw; use Stylesw;
with Validsw; use Validsw;
separate (Par)
procedure Load is
File_Name : File_Name_Type;
Cur_Unum : Unit_Number_Type := Current_Source_Unit;
Curunit : constant Node_Id := Cunit (Cur_Unum);
Loc : Source_Ptr := Sloc (Curunit);
Save_Style_Check : Boolean;
Save_Style_Checks : Style_Check_Options;
Save_Validity_Check : Boolean;
Save_Validity_Checks : Validity_Check_Options;
With_Cunit : Node_Id;
Context_Node : Node_Id;
With_Node : Node_Id;
Spec_Name : Unit_Name_Type;
Body_Name : Unit_Name_Type;
Unum : Unit_Number_Type;
function Same_File_Name_Except_For_Case
(Expected_File_Name : File_Name_Type;
Actual_File_Name : File_Name_Type)
return Boolean;
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;
begin
if Fatal_Error (Cur_Unum) 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 Cur_Unum = Main_Unit then
Main_Unit_Entity := Cunit_Entity (Main_Unit);
end if;
if Unit_Name (Cur_Unum) = No_Name then
raise Unrecoverable_Error;
end if;
File_Name :=
Get_File_Name
(Unit_Name (Cur_Unum),
Subunit => Nkind (Unit (Cunit (Cur_Unum))) = N_Subunit);
if Cur_Unum = Main_Unit
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_Name_1 := File_Name;
Error_Msg
("?file name does not match unit name, should be{", Sloc (Curunit));
end if;
if Cur_Unum /= Main_Unit
and then Expected_Unit (Cur_Unum) /= Unit_Name (Cur_Unum)
then
Loc := Error_Location (Cur_Unum);
Error_Msg_Name_1 := Unit_File_Name (Cur_Unum);
Get_Name_String (Error_Msg_Name_1);
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
Error_Msg_Name_1 := Expected_Unit (Cur_Unum);
Error_Msg ("% is not a predefined library unit!", Loc);
Error_Msg_Name_1 := Unit_Name (Cur_Unum);
Error_Msg ("possible misspelling of %!", Loc);
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;
raise Unrecoverable_Error;
end if;
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);
if Unum /= No_Unit then
Set_Library_Unit (Curunit, Cunit (Unum));
if Cur_Unum = Main_Unit then
Main_Unit_Entity := Cunit_Entity (Unum);
end if;
elsif Nkind (Unit (Curunit)) = N_Subprogram_Body then
Set_Acts_As_Spec (Curunit, True);
Set_Library_Unit (Curunit, Curunit);
else
Unum :=
Load_Unit
(Load_Name => Spec_Name,
Required => True,
Subunit => False,
Error_Node => Curunit);
return;
end if;
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
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_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;
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 => True,
Error_Node => Name (Unit (Curunit)));
if Unum /= No_Unit then
Set_Library_Unit (Curunit, Cunit (Unum));
end if;
end if;
if not GNAT_Mode then
Reset_Style_Check_Options;
Reset_Validity_Check_Options;
end if;
Context_Node := First (Context_Items (Curunit));
while Present (Context_Node) loop
if Nkind (Context_Node) = N_With_Clause 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);
if Unum /= No_Unit then
Set_Library_Unit (With_Node, Cunit (Unum));
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 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);
else
Unum :=
Load_Unit
(Load_Name => Spec_Name,
Required => True,
Subunit => False,
Error_Node => With_Node,
Renamings => True);
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;
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;