[multiple changes]
2010-09-10 Vincent Celier <celier@adacore.com> * vms_data.ads: Add new GNAT BIND qualifiers /32_MALLOC (for -H32) and /64_MALLOC (for -H64). 2010-09-10 Robert Dewar <dewar@adacore.com> * errout.adb (Error_Msg_Internal): Test Parsing_Main_Subunit flag (Error_Msg_NW): Test Parsing_Main_Subunit flag * errout.ads (Parsing_Main_Subunit): New flag * lib-load.adb (Load_Unit): Set Parsing_Main_Subunit flag * par-ch6.adb: Minor style fix (remove redandant parentheses) * par-ch9.adb: Minor style fix (remove redundant parens) * par-load.adb: (Load): Deal with setting Parsing_Main_Subunit 2010-09-10 Vincent Celier <celier@adacore.com> * make.adb (Create_Binder_Mapping_File): Remove procedure. Replaced by function of the same name in Makeutl. (Gnatmake): Call function Create_Binder_Mapping_File in Makeutl, instead of removed procedure when creating a binder mapping file. * makeutl.adb (Create_Binder_Mapping_File): New function. Was a procedure in Make. * makeutl.ads (Create_Binder_Mapping_File): New function From-SVN: r164176
This commit is contained in:
Arnaud Charlet
parent
0856403616
commit
a113c55d5a
11 changed files with 282 additions and 209 deletions
|
|
@ -1,3 +1,28 @@
|
|||
2010-09-10 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* vms_data.ads: Add new GNAT BIND qualifiers /32_MALLOC (for -H32) and
|
||||
/64_MALLOC (for -H64).
|
||||
|
||||
2010-09-10 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* errout.adb (Error_Msg_Internal): Test Parsing_Main_Subunit flag
|
||||
(Error_Msg_NW): Test Parsing_Main_Subunit flag
|
||||
* errout.ads (Parsing_Main_Subunit): New flag
|
||||
* lib-load.adb (Load_Unit): Set Parsing_Main_Subunit flag
|
||||
* par-ch6.adb: Minor style fix (remove redandant parentheses)
|
||||
* par-ch9.adb: Minor style fix (remove redundant parens)
|
||||
* par-load.adb: (Load): Deal with setting Parsing_Main_Subunit
|
||||
|
||||
2010-09-10 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* make.adb (Create_Binder_Mapping_File): Remove procedure. Replaced by
|
||||
function of the same name in Makeutl.
|
||||
(Gnatmake): Call function Create_Binder_Mapping_File in Makeutl, instead
|
||||
of removed procedure when creating a binder mapping file.
|
||||
* makeutl.adb (Create_Binder_Mapping_File): New function. Was a
|
||||
procedure in Make.
|
||||
* makeutl.ads (Create_Binder_Mapping_File): New function
|
||||
|
||||
2010-09-10 Jose Ruiz <ruiz@adacore.com>
|
||||
|
||||
* exp_cg.adb (Is_Predefined_Dispatching_Operation): Add the "__" scope
|
||||
|
|
|
|||
|
|
@ -748,7 +748,9 @@ package body Errout is
|
|||
-- If the flag location is in the main extended source unit then for
|
||||
-- sure we want the warning since it definitely belongs
|
||||
|
||||
if In_Extended_Main_Source_Unit (Sptr) then
|
||||
if Parsing_Main_Subunit
|
||||
or else In_Extended_Main_Source_Unit (Sptr)
|
||||
then
|
||||
null;
|
||||
|
||||
-- If the flag location is not in the main extended source unit, then
|
||||
|
|
@ -1157,7 +1159,8 @@ package body Errout is
|
|||
is
|
||||
begin
|
||||
if Eflag
|
||||
and then In_Extended_Main_Source_Unit (N)
|
||||
and then (Parsing_Main_Subunit
|
||||
or else In_Extended_Main_Source_Unit (N))
|
||||
and then Comes_From_Source (N)
|
||||
then
|
||||
Error_Msg_NEL (Msg, N, N, Sloc (N));
|
||||
|
|
|
|||
|
|
@ -63,9 +63,17 @@ package Errout is
|
|||
type Compiler_State_Type is (Parsing, Analyzing);
|
||||
Compiler_State : Compiler_State_Type;
|
||||
-- Indicates current state of compilation. This is put in the Errout spec
|
||||
-- because it affects the action of the error message handling. In
|
||||
-- particular, an attempt is made by Errout to suppress cascaded error
|
||||
-- messages in Parsing mode, but not in the other modes.
|
||||
-- because it affects the handling of error messages. In particular, an
|
||||
-- attempt is made by Errout to suppress cascaded error messages in Parsing
|
||||
-- mode, but not in the other modes.
|
||||
|
||||
Parsing_Main_Subunit : Boolean := False;
|
||||
-- Set True if we are currently parsing a subunit that is part of the main
|
||||
-- extended source. We need this flag, since the In_Main_Extended_Source
|
||||
-- test may produce an improper False value if called too early during the
|
||||
-- parsing process. This is put in the Errout spec because it affects error
|
||||
-- message handling. In particular, warnings and style messages during
|
||||
-- parsing are only generated if this flag is set to True.
|
||||
|
||||
Current_Error_Source_File : Source_File_Index
|
||||
renames Err_Vars.Current_Error_Source_File;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2010, 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- --
|
||||
|
|
@ -513,7 +513,6 @@ package body Lib.Load is
|
|||
-- See if we already have an entry for this unit
|
||||
|
||||
Unum := Main_Unit;
|
||||
|
||||
while Unum <= Units.Last loop
|
||||
exit when Uname_Actual = Units.Table (Unum).Unit_Name;
|
||||
Unum := Unum + 1;
|
||||
|
|
@ -658,12 +657,22 @@ package body Lib.Load is
|
|||
-- Parse the new unit
|
||||
|
||||
declare
|
||||
Save_Index : constant Nat := Multiple_Unit_Index;
|
||||
Save_Index : constant Nat := Multiple_Unit_Index;
|
||||
Save_PMS : constant Boolean := Parsing_Main_Subunit;
|
||||
|
||||
begin
|
||||
Multiple_Unit_Index := Get_Unit_Index (Uname_Actual);
|
||||
Units.Table (Unum).Munit_Index := Multiple_Unit_Index;
|
||||
Initialize_Scanner (Unum, Source_Index (Unum));
|
||||
|
||||
if Calling_Unit = Main_Unit and then Subunit then
|
||||
Parsing_Main_Subunit := True;
|
||||
end if;
|
||||
|
||||
Discard_List (Par (Configuration_Pragmas => False));
|
||||
|
||||
Parsing_Main_Subunit := Save_PMS;
|
||||
|
||||
Multiple_Unit_Index := Save_Index;
|
||||
Set_Loading (Unum, False);
|
||||
end;
|
||||
|
|
|
|||
191
gcc/ada/make.adb
191
gcc/ada/make.adb
|
|
@ -4136,10 +4136,6 @@ package body Make is
|
|||
-- Check that the main subprograms do exist and that they all
|
||||
-- belong to the same project file.
|
||||
|
||||
procedure Create_Binder_Mapping_File
|
||||
(Args : in out Argument_List; Last_Arg : in out Natural);
|
||||
-- Create a binder mapping file and add the necessary switch
|
||||
|
||||
-----------------
|
||||
-- Check_Mains --
|
||||
-----------------
|
||||
|
|
@ -4282,185 +4278,6 @@ package body Make is
|
|||
end loop;
|
||||
end Check_Mains;
|
||||
|
||||
--------------------------------
|
||||
-- Create_Binder_Mapping_File --
|
||||
--------------------------------
|
||||
|
||||
procedure Create_Binder_Mapping_File
|
||||
(Args : in out Argument_List; Last_Arg : in out Natural)
|
||||
is
|
||||
Mapping_FD : File_Descriptor := Invalid_FD;
|
||||
-- A File Descriptor for an eventual mapping file
|
||||
|
||||
ALI_Unit : Unit_Name_Type := No_Unit_Name;
|
||||
-- The unit name of an ALI file
|
||||
|
||||
ALI_Name : File_Name_Type := No_File;
|
||||
-- The file name of the ALI file
|
||||
|
||||
ALI_Project : Project_Id := No_Project;
|
||||
-- The project of the ALI file
|
||||
|
||||
Bytes : Integer;
|
||||
OK : Boolean := True;
|
||||
Unit : Unit_Index;
|
||||
|
||||
Status : Boolean;
|
||||
-- For call to Close
|
||||
|
||||
begin
|
||||
Tempdir.Create_Temp_File (Mapping_FD, Mapping_Path);
|
||||
Record_Temp_File (Project_Tree, Mapping_Path);
|
||||
|
||||
if Mapping_FD /= Invalid_FD then
|
||||
|
||||
-- Traverse all units
|
||||
|
||||
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
|
||||
|
||||
while Unit /= No_Unit_Index loop
|
||||
if Unit.Name /= No_Name then
|
||||
|
||||
-- If there is a body, put it in the mapping
|
||||
|
||||
if Unit.File_Names (Impl) /= No_Source
|
||||
and then Unit.File_Names (Impl).Project /=
|
||||
No_Project
|
||||
then
|
||||
Get_Name_String (Unit.Name);
|
||||
Add_Str_To_Name_Buffer ("%b");
|
||||
ALI_Unit := Name_Find;
|
||||
ALI_Name :=
|
||||
Lib_File_Name
|
||||
(Unit.File_Names (Impl).Display_File);
|
||||
ALI_Project := Unit.File_Names (Impl).Project;
|
||||
|
||||
-- Otherwise, if there is a spec, put it in the mapping
|
||||
|
||||
elsif Unit.File_Names (Spec) /= No_Source
|
||||
and then Unit.File_Names (Spec).Project /= No_Project
|
||||
then
|
||||
Get_Name_String (Unit.Name);
|
||||
Add_Str_To_Name_Buffer ("%s");
|
||||
ALI_Unit := Name_Find;
|
||||
ALI_Name :=
|
||||
Lib_File_Name
|
||||
(Unit.File_Names (Spec).Display_File);
|
||||
ALI_Project := Unit.File_Names (Spec).Project;
|
||||
|
||||
else
|
||||
ALI_Name := No_File;
|
||||
end if;
|
||||
|
||||
-- If we have something to put in the mapping then do it
|
||||
-- now. However, if the project is extended, we don't put
|
||||
-- anything in the mapping file, because we don't know where
|
||||
-- the ALI file is: it might be in the extended project
|
||||
-- object directory as well as in the extending project
|
||||
-- object directory.
|
||||
|
||||
if ALI_Name /= No_File
|
||||
and then ALI_Project.Extended_By = No_Project
|
||||
and then ALI_Project.Extends = No_Project
|
||||
then
|
||||
-- First check if the ALI file exists. If it does not,
|
||||
-- do not put the unit in the mapping file.
|
||||
|
||||
declare
|
||||
ALI : constant String := Get_Name_String (ALI_Name);
|
||||
|
||||
begin
|
||||
-- For library projects, use the library directory,
|
||||
-- for other projects, use the object directory.
|
||||
|
||||
if ALI_Project.Library then
|
||||
Get_Name_String (ALI_Project.Library_Dir.Name);
|
||||
else
|
||||
Get_Name_String
|
||||
(ALI_Project.Object_Directory.Display_Name);
|
||||
end if;
|
||||
|
||||
if not
|
||||
Is_Directory_Separator (Name_Buffer (Name_Len))
|
||||
then
|
||||
Add_Char_To_Name_Buffer (Directory_Separator);
|
||||
end if;
|
||||
|
||||
Add_Str_To_Name_Buffer (ALI);
|
||||
Add_Char_To_Name_Buffer (ASCII.LF);
|
||||
|
||||
declare
|
||||
ALI_Path_Name : constant String :=
|
||||
Name_Buffer (1 .. Name_Len);
|
||||
|
||||
begin
|
||||
if Is_Regular_File
|
||||
(ALI_Path_Name (1 .. ALI_Path_Name'Last - 1))
|
||||
then
|
||||
-- First line is the unit name
|
||||
|
||||
Get_Name_String (ALI_Unit);
|
||||
Add_Char_To_Name_Buffer (ASCII.LF);
|
||||
Bytes :=
|
||||
Write
|
||||
(Mapping_FD,
|
||||
Name_Buffer (1)'Address,
|
||||
Name_Len);
|
||||
OK := Bytes = Name_Len;
|
||||
|
||||
exit when not OK;
|
||||
|
||||
-- Second line it the ALI file name
|
||||
|
||||
Get_Name_String (ALI_Name);
|
||||
Add_Char_To_Name_Buffer (ASCII.LF);
|
||||
Bytes :=
|
||||
Write
|
||||
(Mapping_FD,
|
||||
Name_Buffer (1)'Address,
|
||||
Name_Len);
|
||||
OK := (Bytes = Name_Len);
|
||||
|
||||
exit when not OK;
|
||||
|
||||
-- Third line it the ALI path name
|
||||
|
||||
Bytes :=
|
||||
Write
|
||||
(Mapping_FD,
|
||||
ALI_Path_Name (1)'Address,
|
||||
ALI_Path_Name'Length);
|
||||
OK := (Bytes = ALI_Path_Name'Length);
|
||||
|
||||
-- If OK is False, it means we were unable to
|
||||
-- write a line. No point in continuing with the
|
||||
-- other units.
|
||||
|
||||
exit when not OK;
|
||||
end if;
|
||||
end;
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
|
||||
end loop;
|
||||
|
||||
Close (Mapping_FD, Status);
|
||||
|
||||
OK := OK and Status;
|
||||
|
||||
-- If the creation of the mapping file was successful, we add the
|
||||
-- switch to the arguments of gnatbind.
|
||||
|
||||
if OK then
|
||||
Last_Arg := Last_Arg + 1;
|
||||
Args (Last_Arg) :=
|
||||
new String'("-F=" & Get_Name_String (Mapping_Path));
|
||||
end if;
|
||||
end if;
|
||||
end Create_Binder_Mapping_File;
|
||||
|
||||
-- Start of processing for Gnatmake
|
||||
|
||||
-- This body is very long, should be broken down???
|
||||
|
|
@ -6013,7 +5830,13 @@ package body Make is
|
|||
-- If switch -C was specified, create a binder mapping file
|
||||
|
||||
if Create_Mapping_File then
|
||||
Create_Binder_Mapping_File (Args, Last_Arg);
|
||||
Mapping_Path := Create_Binder_Mapping_File;
|
||||
|
||||
if Mapping_Path /= No_Path then
|
||||
Last_Arg := Last_Arg + 1;
|
||||
Args (Last_Arg) :=
|
||||
new String'("-F=" & Get_Name_String (Mapping_Path));
|
||||
end if;
|
||||
end if;
|
||||
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -34,6 +34,7 @@ with Prj.Ext;
|
|||
with Prj.Util;
|
||||
with Snames; use Snames;
|
||||
with Table;
|
||||
with Tempdir;
|
||||
|
||||
with Ada.Command_Line; use Ada.Command_Line;
|
||||
|
||||
|
|
@ -295,6 +296,183 @@ package body Makeutl is
|
|||
return True;
|
||||
end Check_Source_Info_In_ALI;
|
||||
|
||||
--------------------------------
|
||||
-- Create_Binder_Mapping_File --
|
||||
--------------------------------
|
||||
|
||||
function Create_Binder_Mapping_File return Path_Name_Type is
|
||||
Mapping_Path : Path_Name_Type := No_Path;
|
||||
|
||||
Mapping_FD : File_Descriptor := Invalid_FD;
|
||||
-- A File Descriptor for an eventual mapping file
|
||||
|
||||
ALI_Unit : Unit_Name_Type := No_Unit_Name;
|
||||
-- The unit name of an ALI file
|
||||
|
||||
ALI_Name : File_Name_Type := No_File;
|
||||
-- The file name of the ALI file
|
||||
|
||||
ALI_Project : Project_Id := No_Project;
|
||||
-- The project of the ALI file
|
||||
|
||||
Bytes : Integer;
|
||||
OK : Boolean := False;
|
||||
Unit : Unit_Index;
|
||||
|
||||
Status : Boolean;
|
||||
-- For call to Close
|
||||
|
||||
begin
|
||||
Tempdir.Create_Temp_File (Mapping_FD, Mapping_Path);
|
||||
Record_Temp_File (Project_Tree, Mapping_Path);
|
||||
|
||||
if Mapping_FD /= Invalid_FD then
|
||||
OK := True;
|
||||
|
||||
-- Traverse all units
|
||||
|
||||
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
|
||||
while Unit /= No_Unit_Index loop
|
||||
if Unit.Name /= No_Name then
|
||||
|
||||
-- If there is a body, put it in the mapping
|
||||
|
||||
if Unit.File_Names (Impl) /= No_Source
|
||||
and then Unit.File_Names (Impl).Project /= No_Project
|
||||
then
|
||||
Get_Name_String (Unit.Name);
|
||||
Add_Str_To_Name_Buffer ("%b");
|
||||
ALI_Unit := Name_Find;
|
||||
ALI_Name :=
|
||||
Lib_File_Name (Unit.File_Names (Impl).Display_File);
|
||||
ALI_Project := Unit.File_Names (Impl).Project;
|
||||
|
||||
-- Otherwise, if there is a spec, put it in the mapping
|
||||
|
||||
elsif Unit.File_Names (Spec) /= No_Source
|
||||
and then Unit.File_Names (Spec).Project /= No_Project
|
||||
then
|
||||
Get_Name_String (Unit.Name);
|
||||
Add_Str_To_Name_Buffer ("%s");
|
||||
ALI_Unit := Name_Find;
|
||||
ALI_Name :=
|
||||
Lib_File_Name (Unit.File_Names (Spec).Display_File);
|
||||
ALI_Project := Unit.File_Names (Spec).Project;
|
||||
|
||||
else
|
||||
ALI_Name := No_File;
|
||||
end if;
|
||||
|
||||
-- If we have something to put in the mapping then do it now.
|
||||
-- However, if the project is extended, we don't put anything
|
||||
-- in the mapping file, since we don't know where the ALI file
|
||||
-- is: it might be in the extended project object directory as
|
||||
-- well as in the extending project object directory.
|
||||
|
||||
if ALI_Name /= No_File
|
||||
and then ALI_Project.Extended_By = No_Project
|
||||
and then ALI_Project.Extends = No_Project
|
||||
then
|
||||
-- First check if the ALI file exists. If it does not, do
|
||||
-- not put the unit in the mapping file.
|
||||
|
||||
declare
|
||||
ALI : constant String := Get_Name_String (ALI_Name);
|
||||
|
||||
begin
|
||||
-- For library projects, use the library ALI directory,
|
||||
-- for other projects, use the object directory.
|
||||
|
||||
if ALI_Project.Library then
|
||||
Get_Name_String
|
||||
(ALI_Project.Library_ALI_Dir.Display_Name);
|
||||
else
|
||||
Get_Name_String
|
||||
(ALI_Project.Object_Directory.Display_Name);
|
||||
end if;
|
||||
|
||||
if not
|
||||
Is_Directory_Separator (Name_Buffer (Name_Len))
|
||||
then
|
||||
Add_Char_To_Name_Buffer (Directory_Separator);
|
||||
end if;
|
||||
|
||||
Add_Str_To_Name_Buffer (ALI);
|
||||
Add_Char_To_Name_Buffer (ASCII.LF);
|
||||
|
||||
declare
|
||||
ALI_Path_Name : constant String :=
|
||||
Name_Buffer (1 .. Name_Len);
|
||||
|
||||
begin
|
||||
if Is_Regular_File
|
||||
(ALI_Path_Name (1 .. ALI_Path_Name'Last - 1))
|
||||
then
|
||||
-- First line is the unit name
|
||||
|
||||
Get_Name_String (ALI_Unit);
|
||||
Add_Char_To_Name_Buffer (ASCII.LF);
|
||||
Bytes :=
|
||||
Write
|
||||
(Mapping_FD,
|
||||
Name_Buffer (1)'Address,
|
||||
Name_Len);
|
||||
OK := Bytes = Name_Len;
|
||||
|
||||
exit when not OK;
|
||||
|
||||
-- Second line it the ALI file name
|
||||
|
||||
Get_Name_String (ALI_Name);
|
||||
Add_Char_To_Name_Buffer (ASCII.LF);
|
||||
Bytes :=
|
||||
Write
|
||||
(Mapping_FD,
|
||||
Name_Buffer (1)'Address,
|
||||
Name_Len);
|
||||
OK := (Bytes = Name_Len);
|
||||
|
||||
exit when not OK;
|
||||
|
||||
-- Third line it the ALI path name
|
||||
|
||||
Bytes :=
|
||||
Write
|
||||
(Mapping_FD,
|
||||
ALI_Path_Name (1)'Address,
|
||||
ALI_Path_Name'Length);
|
||||
OK := (Bytes = ALI_Path_Name'Length);
|
||||
|
||||
-- If OK is False, it means we were unable to
|
||||
-- write a line. No point in continuing with the
|
||||
-- other units.
|
||||
|
||||
exit when not OK;
|
||||
end if;
|
||||
end;
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
|
||||
end loop;
|
||||
|
||||
Close (Mapping_FD, Status);
|
||||
|
||||
OK := OK and Status;
|
||||
end if;
|
||||
|
||||
-- If the creation of the mapping file was successful, we add the switch
|
||||
-- to the arguments of gnatbind.
|
||||
|
||||
if OK then
|
||||
return Mapping_Path;
|
||||
|
||||
else
|
||||
return No_Path;
|
||||
end if;
|
||||
end Create_Binder_Mapping_File;
|
||||
|
||||
-----------------
|
||||
-- Create_Name --
|
||||
-----------------
|
||||
|
|
|
|||
|
|
@ -70,6 +70,9 @@ package Makeutl is
|
|||
Last : in out Natural);
|
||||
-- Add a string to a list of strings
|
||||
|
||||
function Create_Binder_Mapping_File return Path_Name_Type;
|
||||
-- Create a binder mapping file and returns its path name
|
||||
|
||||
function Create_Name (Name : String) return File_Name_Type;
|
||||
function Create_Name (Name : String) return Name_Id;
|
||||
function Create_Name (Name : String) return Path_Name_Type;
|
||||
|
|
|
|||
|
|
@ -211,7 +211,7 @@ package body Ch6 is
|
|||
Is_Overriding := True;
|
||||
end if;
|
||||
|
||||
if (Is_Overriding or else Not_Overriding) then
|
||||
if Is_Overriding or else Not_Overriding then
|
||||
|
||||
-- Note that if we are not in Ada_05 mode, error messages have
|
||||
-- already been given, so no need to give another message here.
|
||||
|
|
|
|||
|
|
@ -639,7 +639,7 @@ package body Ch9 is
|
|||
Is_Overriding := True;
|
||||
end if;
|
||||
|
||||
if (Is_Overriding or else Not_Overriding) then
|
||||
if Is_Overriding or else Not_Overriding then
|
||||
if Ada_Version < Ada_05 then
|
||||
Error_Msg_SP ("overriding indicator is an Ada 2005 extension");
|
||||
Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
|
||||
|
|
@ -823,7 +823,7 @@ package body Ch9 is
|
|||
Is_Overriding := True;
|
||||
end if;
|
||||
|
||||
if (Is_Overriding or else Not_Overriding) then
|
||||
if Is_Overriding or else Not_Overriding then
|
||||
if Ada_Version < Ada_05 then
|
||||
Error_Msg_SP ("overriding indicator is an Ada 2005 extension");
|
||||
Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2010, 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- --
|
||||
|
|
@ -268,9 +268,9 @@ begin
|
|||
Error_Node => Curunit,
|
||||
Corr_Body => Cur_Unum);
|
||||
|
||||
-- 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 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));
|
||||
|
|
@ -342,17 +342,25 @@ begin
|
|||
-- 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 => True,
|
||||
Error_Node => Name (Unit (Curunit)));
|
||||
declare
|
||||
Save_PMS : constant Boolean := Parsing_Main_Subunit;
|
||||
|
||||
if Unum /= No_Unit then
|
||||
Set_Library_Unit (Curunit, Cunit (Unum));
|
||||
end if;
|
||||
begin
|
||||
Parsing_Main_Subunit := False;
|
||||
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;
|
||||
|
||||
Parsing_Main_Subunit := Save_PMS;
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Now we load with'ed units, with style/validity checks turned off
|
||||
|
|
|
|||
|
|
@ -353,6 +353,20 @@ package VMS_Data is
|
|||
--
|
||||
-- The main program is not in Ada.
|
||||
|
||||
S_Bind_Alloc32 : aliased constant S := "/32_MALLOC " &
|
||||
"-H32";
|
||||
-- /32_MALLOC
|
||||
--
|
||||
-- Use 32-bit allocations for `__gnat_malloc' (and thus for
|
||||
-- access types).
|
||||
|
||||
S_Bind_Alloc64 : aliased constant S := "/64_MALLOC " &
|
||||
"-H64";
|
||||
-- /64_MALLOC
|
||||
--
|
||||
-- Use 64-bit allocations for `__gnat_malloc' (and thus for
|
||||
-- access types).
|
||||
|
||||
S_Bind_Mess : aliased constant S := "/MESSAGES_PROJECT_FILE=" &
|
||||
"DEFAULT " &
|
||||
"-vP0 " &
|
||||
|
|
@ -694,6 +708,8 @@ package VMS_Data is
|
|||
S_Bind_Library 'Access,
|
||||
S_Bind_Linker 'Access,
|
||||
S_Bind_Main 'Access,
|
||||
S_Bind_Alloc32 'Access,
|
||||
S_Bind_Alloc64 'Access,
|
||||
S_Bind_Mess 'Access,
|
||||
S_Bind_Nostinc 'Access,
|
||||
S_Bind_Nostlib 'Access,
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue