[multiple changes]
2017-05-02 Bob Duff <duff@adacore.com> * sem_attr.adb (Attribute_Enum_Rep): Disallow T'Enum_Rep. 2017-05-02 Vasiliy Fofanov <fofanov@adacore.com> * s-os_lib.ads: Minor typo fix. 2017-05-02 Vasiliy Fofanov <fofanov@adacore.com> * gnatls.adb: Merge and refactor code from Prj.Env and remove this deprecated dependency. 2017-05-02 Ed Schonberg <schonberg@adacore.com> * exp_util.ads: minor comment addition. 2017-05-02 Eric Botcazou <ebotcazou@adacore.com> * sem_ch3.adb (Build_Derived_Record_Type): Fix a few typos and pastos in part #3 of the head comment. 2017-05-02 Ed Schonberg <schonberg@adacore.com> * exp_ch3.adb (Freeze_Type): Do not generate an invariant procedure body for a local (sub)type declaration within a predicate function. Invariant checks do not apply to these, and the expansion of the procedure will happen in the wrong scope, leading to misplaced freeze nodes. 2017-05-02 Ed Schonberg <schonberg@adacore.com> * exp_util.adb (Insert_Library_Level_Action): Use proper scope to analyze generated actions. If the main unit is a body, the required scope is that of the corresponding unit declaration. 2017-05-02 Arnaud Charlet <charlet@adacore.com> * einfo.adb (Declaration_Node): flip branches of an IF statement to avoid repeated negations in its condition; no change in semantics, only to improve readability. From-SVN: r247480
This commit is contained in:
Arnaud Charlet
parent
2d249f52b5
commit
d6fd1f07ac
9 changed files with 556 additions and 46 deletions
|
|
@ -1,3 +1,45 @@
|
|||
2017-05-02 Bob Duff <duff@adacore.com>
|
||||
|
||||
* sem_attr.adb (Attribute_Enum_Rep): Disallow T'Enum_Rep.
|
||||
|
||||
2017-05-02 Vasiliy Fofanov <fofanov@adacore.com>
|
||||
|
||||
* s-os_lib.ads: Minor typo fix.
|
||||
|
||||
2017-05-02 Vasiliy Fofanov <fofanov@adacore.com>
|
||||
|
||||
* gnatls.adb: Merge and refactor code from Prj.Env and remove
|
||||
this deprecated dependency.
|
||||
|
||||
2017-05-02 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_util.ads: minor comment addition.
|
||||
|
||||
2017-05-02 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Build_Derived_Record_Type): Fix a few typos and
|
||||
pastos in part #3 of the head comment.
|
||||
|
||||
2017-05-02 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_ch3.adb (Freeze_Type): Do not generate an invariant
|
||||
procedure body for a local (sub)type declaration within a
|
||||
predicate function. Invariant checks do not apply to these, and
|
||||
the expansion of the procedure will happen in the wrong scope,
|
||||
leading to misplaced freeze nodes.
|
||||
|
||||
2017-05-02 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_util.adb (Insert_Library_Level_Action): Use proper scope
|
||||
to analyze generated actions. If the main unit is a body,
|
||||
the required scope is that of the corresponding unit declaration.
|
||||
|
||||
2017-05-02 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* einfo.adb (Declaration_Node): flip branches of
|
||||
an IF statement to avoid repeated negations in its condition;
|
||||
no change in semantics, only to improve readability.
|
||||
|
||||
2017-05-02 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* sem_case.adb: Remove extra spaces in parameter declarations.
|
||||
|
|
|
|||
|
|
@ -7117,15 +7117,13 @@ package body Einfo is
|
|||
end if;
|
||||
|
||||
loop
|
||||
if Nkind (P) /= N_Selected_Component
|
||||
and then Nkind (P) /= N_Expanded_Name
|
||||
and then
|
||||
not (Nkind (P) = N_Defining_Program_Unit_Name
|
||||
and then Is_Child_Unit (Id))
|
||||
if Nkind_In (P, N_Selected_Component, N_Expanded_Name)
|
||||
or else (Nkind (P) = N_Defining_Program_Unit_Name
|
||||
and then Is_Child_Unit (Id))
|
||||
then
|
||||
return P;
|
||||
else
|
||||
P := Parent (P);
|
||||
else
|
||||
return P;
|
||||
end if;
|
||||
end loop;
|
||||
end Declaration_Node;
|
||||
|
|
|
|||
|
|
@ -7554,8 +7554,19 @@ package body Exp_Ch3 is
|
|||
|
||||
-- Non-interface types
|
||||
|
||||
-- Do not generate invariant procedure within other assertion
|
||||
-- subprograms, which may involve local declarations of local
|
||||
-- subtypes to which these checks don't apply.
|
||||
|
||||
elsif Has_Invariants (Def_Id) then
|
||||
Build_Invariant_Procedure_Body (Def_Id);
|
||||
if Within_Internal_Subprogram
|
||||
or else (Ekind (Current_Scope) = E_Function
|
||||
and then Is_Predicate_Function (Current_Scope))
|
||||
then
|
||||
null;
|
||||
else
|
||||
Build_Invariant_Procedure_Body (Def_Id);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Restore_Ghost_Mode (Saved_GM);
|
||||
|
|
|
|||
|
|
@ -7491,8 +7491,10 @@ package body Exp_Util is
|
|||
Aux : constant Node_Id := Aux_Decls_Node (Cunit (Main_Unit));
|
||||
|
||||
begin
|
||||
Push_Scope (Cunit_Entity (Main_Unit));
|
||||
-- ??? should this be Current_Sem_Unit instead of Main_Unit?
|
||||
Push_Scope (Cunit_Entity (Current_Sem_Unit));
|
||||
-- And not Main_Unit as previously. If the main unit is a body,
|
||||
-- the scope needed to analyze the actions is the entity of the
|
||||
-- corresponding declaration.
|
||||
|
||||
if No (Actions (Aux)) then
|
||||
Set_Actions (Aux, New_List (N));
|
||||
|
|
|
|||
|
|
@ -1177,7 +1177,9 @@ package Exp_Util is
|
|||
function Within_Internal_Subprogram return Boolean;
|
||||
-- Indicates that some expansion is taking place within the body of a
|
||||
-- predefined primitive operation. Some expansion activity (e.g. predicate
|
||||
-- checks) is disabled in such.
|
||||
-- checks) is disabled in such. Because we want to detect invalid uses
|
||||
-- of function calls within predicates (which lead to infinite recursion)
|
||||
-- predicate functions themselves are not considered internal here.
|
||||
|
||||
private
|
||||
pragma Inline (Duplicate_Subexpr);
|
||||
|
|
|
|||
|
|
@ -23,6 +23,8 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
pragma Ada_2012;
|
||||
|
||||
with ALI; use ALI;
|
||||
with ALI.Util; use ALI.Util;
|
||||
with Binderr; use Binderr;
|
||||
|
|
@ -30,13 +32,12 @@ with Butil; use Butil;
|
|||
with Csets; use Csets;
|
||||
with Fname; use Fname;
|
||||
with Gnatvsn; use Gnatvsn;
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
with Makeutl; use Makeutl;
|
||||
with Namet; use Namet;
|
||||
with Opt; use Opt;
|
||||
with Osint; use Osint;
|
||||
with Osint.L; use Osint.L;
|
||||
with Output; use Output;
|
||||
with Prj.Env; use Prj.Env;
|
||||
with Rident; use Rident;
|
||||
with Sdefault;
|
||||
with Snames;
|
||||
|
|
@ -44,10 +45,10 @@ with Stringt;
|
|||
with Switch; use Switch;
|
||||
with Types; use Types;
|
||||
|
||||
with Ada.Command_Line; use Ada.Command_Line;
|
||||
|
||||
with GNAT.Command_Line; use GNAT.Command_Line;
|
||||
with GNAT.Case_Util; use GNAT.Case_Util;
|
||||
with GNAT.Case_Util; use GNAT.Case_Util;
|
||||
with GNAT.Command_Line; use GNAT.Command_Line;
|
||||
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
|
||||
procedure Gnatls is
|
||||
pragma Ident (Gnat_Static_Version_String);
|
||||
|
|
@ -59,7 +60,7 @@ procedure Gnatls is
|
|||
-- Label displayed in verbose mode before the directories in the project
|
||||
-- search path. Do not modify without checking NOTE above.
|
||||
|
||||
Prj_Path : Prj.Env.Project_Search_Path;
|
||||
Prj_Path : String_Access;
|
||||
|
||||
Max_Column : constant := 80;
|
||||
|
||||
|
|
@ -212,6 +213,46 @@ procedure Gnatls is
|
|||
|
||||
end GNATDIST;
|
||||
|
||||
------------------------------
|
||||
-- Support for project path --
|
||||
------------------------------
|
||||
|
||||
package Prj_Env is
|
||||
|
||||
procedure Initialize_Default_Project_Path
|
||||
(Self : in out String_Access;
|
||||
Target_Name : String;
|
||||
Runtime_Name : String := "");
|
||||
-- Initialize Self. It will then contain the default project path on
|
||||
-- the given target and runtime (including directories specified by the
|
||||
-- environment variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and
|
||||
-- ADA_PROJECT_PATH). If one of the directory or Target_Name is "-",
|
||||
-- then the path contains only those directories specified by the
|
||||
-- environment variables (except "-"). This does nothing if Self has
|
||||
-- already been initialized.
|
||||
|
||||
procedure Add_Directories
|
||||
(Self : in out String_Access;
|
||||
Path : String;
|
||||
Prepend : Boolean := False);
|
||||
-- Add one or more directories to the path. Directories added with this
|
||||
-- procedure are added in order after the current directory and before
|
||||
-- the path given by the environment variable GPR_PROJECT_PATH. A value
|
||||
-- of "-" will remove the default project directory from the project
|
||||
-- path.
|
||||
--
|
||||
-- Calls to this subprogram must be performed before the first call to
|
||||
-- Find_Project below, or PATH will be added at the end of the search
|
||||
-- path.
|
||||
|
||||
function Get_Runtime_Path
|
||||
(Self : String_Access;
|
||||
Path : String) return String_Access;
|
||||
-- Compute the full path for the project-based runtime name.
|
||||
-- Path is simply searched on the project path.
|
||||
|
||||
end Prj_Env;
|
||||
|
||||
-----------------
|
||||
-- Add_Lib_Dir --
|
||||
-----------------
|
||||
|
|
@ -1187,6 +1228,412 @@ procedure Gnatls is
|
|||
end if;
|
||||
end Output_Unit;
|
||||
|
||||
package body Prj_Env is
|
||||
|
||||
Uninitialized_Prefix : constant String := '#' & Path_Separator;
|
||||
-- Prefix to indicate that the project path has not been initialized
|
||||
-- yet. Must be two characters long
|
||||
|
||||
---------------------
|
||||
-- Add_Directories --
|
||||
---------------------
|
||||
|
||||
procedure Add_Directories
|
||||
(Self : in out String_Access;
|
||||
Path : String;
|
||||
Prepend : Boolean := False)
|
||||
is
|
||||
Tmp : String_Access;
|
||||
begin
|
||||
if Self = null then
|
||||
Self := new String'(Uninitialized_Prefix & Path);
|
||||
else
|
||||
Tmp := Self;
|
||||
if Prepend then
|
||||
Self := new String'(Path & Path_Separator & Tmp.all);
|
||||
else
|
||||
Self := new String'(Tmp.all & Path_Separator & Path);
|
||||
end if;
|
||||
Free (Tmp);
|
||||
end if;
|
||||
|
||||
end Add_Directories;
|
||||
|
||||
-------------------------------------
|
||||
-- Initialize_Default_Project_Path --
|
||||
-------------------------------------
|
||||
|
||||
procedure Initialize_Default_Project_Path
|
||||
(Self : in out String_Access;
|
||||
Target_Name : String;
|
||||
Runtime_Name : String := "")
|
||||
is
|
||||
Add_Default_Dir : Boolean := Target_Name /= "-";
|
||||
First : Positive;
|
||||
Last : Positive;
|
||||
|
||||
Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
|
||||
Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
|
||||
Gpr_Project_Path_File : constant String := "GPR_PROJECT_PATH_FILE";
|
||||
-- Names of alternate env. variables that contain path name(s) of
|
||||
-- directories where project files may reside. They are taken into
|
||||
-- account in this order: GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH,
|
||||
-- ADA_PROJECT_PATH.
|
||||
|
||||
Gpr_Prj_Path_File : String_Access;
|
||||
Gpr_Prj_Path : String_Access;
|
||||
Ada_Prj_Path : String_Access;
|
||||
-- The path name(s) of directories where project files may reside.
|
||||
-- May be empty.
|
||||
|
||||
Prefix : String_Ptr;
|
||||
Runtime : String_Ptr;
|
||||
|
||||
procedure Add_Target (Suffix : String);
|
||||
-- Add :<prefix>/<target>/Suffix to the project path
|
||||
|
||||
FD : File_Descriptor;
|
||||
Len : Integer;
|
||||
|
||||
----------------
|
||||
-- Add_Target --
|
||||
----------------
|
||||
|
||||
procedure Add_Target (Suffix : String) is
|
||||
Extra_Sep : constant String :=
|
||||
(if Target_Name (Target_Name'Last) = '/' then
|
||||
""
|
||||
else
|
||||
(1 => Directory_Separator));
|
||||
-- Note: Target_Name has a trailing / when it comes from Sdefault
|
||||
begin
|
||||
Add_Str_To_Name_Buffer
|
||||
(Path_Separator & Prefix.all & Target_Name & Extra_Sep & Suffix);
|
||||
end Add_Target;
|
||||
|
||||
-- Start of processing for Initialize_Default_Project_Path
|
||||
|
||||
begin
|
||||
if Self /= null
|
||||
and then (Self'Length = 0
|
||||
or else Self (Self'First) /= '#')
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- The current directory is always first in the search path. Since
|
||||
-- the Project_Path currently starts with '#:' as a sign that it
|
||||
-- isn't initialized, we simply replace '#' with '.'
|
||||
|
||||
if Self = null then
|
||||
Self := new String'('.' & Path_Separator);
|
||||
else
|
||||
Self (Self'First) := '.';
|
||||
end if;
|
||||
|
||||
-- Then the reset of the project path (if any) currently contains the
|
||||
-- directories added through Add_Search_Project_Directory
|
||||
|
||||
-- If environment variables are defined and not empty, add their
|
||||
-- content
|
||||
|
||||
Gpr_Prj_Path_File := Getenv (Gpr_Project_Path_File);
|
||||
Gpr_Prj_Path := Getenv (Gpr_Project_Path);
|
||||
Ada_Prj_Path := Getenv (Ada_Project_Path);
|
||||
|
||||
if Gpr_Prj_Path_File.all /= "" then
|
||||
|
||||
FD := Open_Read (Gpr_Prj_Path_File.all, GNAT.OS_Lib.Text);
|
||||
|
||||
if FD = Invalid_FD then
|
||||
Osint.Fail ("warning: could not read project path file """ &
|
||||
Gpr_Prj_Path_File.all & """");
|
||||
end if;
|
||||
|
||||
Len := Integer (File_Length (FD));
|
||||
|
||||
declare
|
||||
Buffer : String (1 .. Len);
|
||||
Index : Positive := 1;
|
||||
Last : Positive;
|
||||
Tmp : String_Access;
|
||||
|
||||
begin
|
||||
-- Read the file
|
||||
|
||||
Len := Read (FD, Buffer (1)'Address, Len);
|
||||
Close (FD);
|
||||
|
||||
-- Scan the file line by line
|
||||
|
||||
while Index < Buffer'Last loop
|
||||
|
||||
-- Find the end of line
|
||||
|
||||
Last := Index;
|
||||
while Last <= Buffer'Last
|
||||
and then Buffer (Last) /= ASCII.LF
|
||||
and then Buffer (Last) /= ASCII.CR
|
||||
loop
|
||||
Last := Last + 1;
|
||||
end loop;
|
||||
|
||||
-- Ignore empty lines
|
||||
|
||||
if Last > Index then
|
||||
Tmp := Self;
|
||||
Self :=
|
||||
new String'
|
||||
(Tmp.all & Path_Separator &
|
||||
Buffer (Index .. Last - 1));
|
||||
Free (Tmp);
|
||||
end if;
|
||||
|
||||
-- Find the beginning of the next line
|
||||
|
||||
Index := Last;
|
||||
while Buffer (Index) = ASCII.CR or else
|
||||
Buffer (Index) = ASCII.LF
|
||||
loop
|
||||
Index := Index + 1;
|
||||
end loop;
|
||||
end loop;
|
||||
end;
|
||||
|
||||
end if;
|
||||
|
||||
if Gpr_Prj_Path.all /= "" then
|
||||
Add_Directories (Self, Gpr_Prj_Path.all);
|
||||
end if;
|
||||
|
||||
Free (Gpr_Prj_Path);
|
||||
|
||||
if Ada_Prj_Path.all /= "" then
|
||||
Add_Directories (Self, Ada_Prj_Path.all);
|
||||
end if;
|
||||
|
||||
Free (Ada_Prj_Path);
|
||||
|
||||
-- Copy to Name_Buffer, since we will need to manipulate the path
|
||||
|
||||
Name_Len := Self'Length;
|
||||
Name_Buffer (1 .. Name_Len) := Self.all;
|
||||
|
||||
-- Scan the directory path to see if "-" is one of the directories.
|
||||
-- Remove each occurrence of "-" and set Add_Default_Dir to False.
|
||||
-- Also resolve relative paths and symbolic links.
|
||||
|
||||
First := 3;
|
||||
loop
|
||||
while First <= Name_Len
|
||||
and then (Name_Buffer (First) = Path_Separator)
|
||||
loop
|
||||
First := First + 1;
|
||||
end loop;
|
||||
|
||||
exit when First > Name_Len;
|
||||
|
||||
Last := First;
|
||||
|
||||
while Last < Name_Len
|
||||
and then Name_Buffer (Last + 1) /= Path_Separator
|
||||
loop
|
||||
Last := Last + 1;
|
||||
end loop;
|
||||
|
||||
-- If the directory is "-", set Add_Default_Dir to False and
|
||||
-- remove from path.
|
||||
|
||||
if Name_Buffer (First .. Last) = "-" then
|
||||
Add_Default_Dir := False;
|
||||
|
||||
for J in Last + 1 .. Name_Len loop
|
||||
Name_Buffer (J - 2) :=
|
||||
Name_Buffer (J);
|
||||
end loop;
|
||||
|
||||
Name_Len := Name_Len - 2;
|
||||
|
||||
-- After removing the '-', go back one character to get the
|
||||
-- next directory correctly.
|
||||
|
||||
Last := Last - 1;
|
||||
|
||||
else
|
||||
declare
|
||||
New_Dir : constant String :=
|
||||
Normalize_Pathname
|
||||
(Name_Buffer (First .. Last),
|
||||
Resolve_Links => Opt.Follow_Links_For_Dirs);
|
||||
New_Len : Positive;
|
||||
New_Last : Positive;
|
||||
|
||||
begin
|
||||
-- If the absolute path was resolved and is different from
|
||||
-- the original, replace original with the resolved path.
|
||||
|
||||
if New_Dir /= Name_Buffer (First .. Last)
|
||||
and then New_Dir'Length /= 0
|
||||
then
|
||||
New_Len := Name_Len + New_Dir'Length - (Last - First + 1);
|
||||
New_Last := First + New_Dir'Length - 1;
|
||||
Name_Buffer (New_Last + 1 .. New_Len) :=
|
||||
Name_Buffer (Last + 1 .. Name_Len);
|
||||
Name_Buffer (First .. New_Last) := New_Dir;
|
||||
Name_Len := New_Len;
|
||||
Last := New_Last;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
First := Last + 1;
|
||||
end loop;
|
||||
|
||||
Free (Self);
|
||||
|
||||
-- Set the initial value of Current_Project_Path
|
||||
|
||||
if Add_Default_Dir then
|
||||
if Sdefault.Search_Dir_Prefix = null then
|
||||
|
||||
-- gprbuild case
|
||||
|
||||
Prefix := new String'(Executable_Prefix_Path);
|
||||
|
||||
else
|
||||
Prefix := new String'(Sdefault.Search_Dir_Prefix.all
|
||||
& ".." & Dir_Separator
|
||||
& ".." & Dir_Separator
|
||||
& ".." & Dir_Separator
|
||||
& ".." & Dir_Separator);
|
||||
end if;
|
||||
|
||||
if Prefix.all /= "" then
|
||||
if Target_Name /= "" then
|
||||
|
||||
if Runtime_Name /= "" then
|
||||
if Base_Name (Runtime_Name) = Runtime_Name then
|
||||
|
||||
-- $prefix/$target/$runtime/lib/gnat
|
||||
Add_Target
|
||||
(Runtime_Name & Directory_Separator &
|
||||
"lib" & Directory_Separator & "gnat");
|
||||
|
||||
-- $prefix/$target/$runtime/share/gpr
|
||||
Add_Target
|
||||
(Runtime_Name & Directory_Separator &
|
||||
"share" & Directory_Separator & "gpr");
|
||||
|
||||
else
|
||||
Runtime :=
|
||||
new String'(Normalize_Pathname (Runtime_Name));
|
||||
|
||||
-- $runtime_dir/lib/gnat
|
||||
Add_Str_To_Name_Buffer
|
||||
(Path_Separator & Runtime.all & Directory_Separator &
|
||||
"lib" & Directory_Separator & "gnat");
|
||||
|
||||
-- $runtime_dir/share/gpr
|
||||
Add_Str_To_Name_Buffer
|
||||
(Path_Separator & Runtime.all & Directory_Separator &
|
||||
"share" & Directory_Separator & "gpr");
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- $prefix/$target/lib/gnat
|
||||
Add_Target
|
||||
("lib" & Directory_Separator & "gnat");
|
||||
|
||||
-- $prefix/$target/share/gpr
|
||||
Add_Target
|
||||
("share" & Directory_Separator & "gpr");
|
||||
end if;
|
||||
|
||||
-- $prefix/share/gpr
|
||||
|
||||
Add_Str_To_Name_Buffer
|
||||
(Path_Separator & Prefix.all & "share"
|
||||
& Directory_Separator & "gpr");
|
||||
|
||||
-- $prefix/lib/gnat
|
||||
|
||||
Add_Str_To_Name_Buffer
|
||||
(Path_Separator & Prefix.all & "lib"
|
||||
& Directory_Separator & "gnat");
|
||||
end if;
|
||||
|
||||
Free (Prefix);
|
||||
end if;
|
||||
|
||||
Self := new String'(Name_Buffer (1 .. Name_Len));
|
||||
end Initialize_Default_Project_Path;
|
||||
|
||||
-----------------------
|
||||
-- Get_Runtime_Path --
|
||||
-----------------------
|
||||
|
||||
function Get_Runtime_Path
|
||||
(Self : String_Access;
|
||||
Path : String) return String_Access
|
||||
is
|
||||
First : Natural;
|
||||
Last : Natural;
|
||||
|
||||
begin
|
||||
|
||||
if Is_Absolute_Path (Path) then
|
||||
if Is_Directory (Path) then
|
||||
return new String'(Path);
|
||||
else
|
||||
return null;
|
||||
end if;
|
||||
|
||||
else
|
||||
-- Because we don't want to resolve symbolic links, we cannot
|
||||
-- use Locate_Regular_File. So, we try each possible path
|
||||
-- successively.
|
||||
|
||||
First := Self'First;
|
||||
while First <= Self'Last loop
|
||||
while First <= Self'Last
|
||||
and then Self (First) = Path_Separator
|
||||
loop
|
||||
First := First + 1;
|
||||
end loop;
|
||||
|
||||
exit when First > Self'Last;
|
||||
|
||||
Last := First;
|
||||
while Last < Self'Last
|
||||
and then Self (Last + 1) /= Path_Separator
|
||||
loop
|
||||
Last := Last + 1;
|
||||
end loop;
|
||||
|
||||
Name_Len := 0;
|
||||
|
||||
if not Is_Absolute_Path (Self (First .. Last)) then
|
||||
Add_Str_To_Name_Buffer (Get_Current_Dir); -- ??? System call
|
||||
Add_Char_To_Name_Buffer (Directory_Separator);
|
||||
end if;
|
||||
|
||||
Add_Str_To_Name_Buffer (Self (First .. Last));
|
||||
Add_Char_To_Name_Buffer (Directory_Separator);
|
||||
Add_Str_To_Name_Buffer (Path);
|
||||
|
||||
if Is_Directory (Name_Buffer (1 .. Name_Len)) then
|
||||
return new String'(Name_Buffer (1 .. Name_Len));
|
||||
end if;
|
||||
|
||||
First := Last + 1;
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
return null;
|
||||
end Get_Runtime_Path;
|
||||
|
||||
end Prj_Env;
|
||||
|
||||
-----------------
|
||||
-- Reset_Print --
|
||||
-----------------
|
||||
|
|
@ -1225,7 +1672,7 @@ procedure Gnatls is
|
|||
if Src_Path /= null and then Lib_Path /= null then
|
||||
Add_Search_Dirs (Src_Path, Include);
|
||||
Add_Search_Dirs (Lib_Path, Objects);
|
||||
Initialize_Default_Project_Path
|
||||
Prj_Env.Initialize_Default_Project_Path
|
||||
(Prj_Path,
|
||||
Target_Name => Sdefault.Target_Name.all,
|
||||
Runtime_Name => Name);
|
||||
|
|
@ -1240,12 +1687,12 @@ procedure Gnatls is
|
|||
|
||||
-- Try to find the RTS on the project path. First setup the project path
|
||||
|
||||
Initialize_Default_Project_Path
|
||||
Prj_Env.Initialize_Default_Project_Path
|
||||
(Prj_Path,
|
||||
Target_Name => Sdefault.Target_Name.all,
|
||||
Runtime_Name => Name);
|
||||
|
||||
Rts_Full_Path := Get_Runtime_Path (Prj_Path, Name);
|
||||
Rts_Full_Path := Prj_Env.Get_Runtime_Path (Prj_Path, Name);
|
||||
|
||||
if Rts_Full_Path /= null then
|
||||
|
||||
|
|
@ -1330,7 +1777,7 @@ procedure Gnatls is
|
|||
-- Processing for -aP<dir>
|
||||
|
||||
elsif Argv'Length > 3 and then Argv (1 .. 3) = "-aP" then
|
||||
Add_Directories (Prj_Path, Argv (4 .. Argv'Last));
|
||||
Prj_Env.Add_Directories (Prj_Path, Argv (4 .. Argv'Last));
|
||||
|
||||
-- Processing for -nostdinc
|
||||
|
||||
|
|
@ -1719,36 +2166,34 @@ begin
|
|||
Write_Str (" <Current_Directory>");
|
||||
Write_Eol;
|
||||
|
||||
Initialize_Default_Project_Path
|
||||
Prj_Env.Initialize_Default_Project_Path
|
||||
(Prj_Path, Target_Name => Sdefault.Target_Name.all);
|
||||
|
||||
declare
|
||||
Project_Path : String_Access;
|
||||
First : Natural;
|
||||
Last : Natural;
|
||||
|
||||
begin
|
||||
Get_Path (Prj_Path, Project_Path);
|
||||
|
||||
if Project_Path.all /= "" then
|
||||
First := Project_Path'First;
|
||||
if Prj_Path.all /= "" then
|
||||
First := Prj_Path'First;
|
||||
loop
|
||||
while First <= Project_Path'Last
|
||||
and then (Project_Path (First) = Path_Separator)
|
||||
while First <= Prj_Path'Last
|
||||
and then (Prj_Path (First) = Path_Separator)
|
||||
loop
|
||||
First := First + 1;
|
||||
end loop;
|
||||
|
||||
exit when First > Project_Path'Last;
|
||||
exit when First > Prj_Path'Last;
|
||||
|
||||
Last := First;
|
||||
while Last < Project_Path'Last
|
||||
and then Project_Path (Last + 1) /= Path_Separator
|
||||
while Last < Prj_Path'Last
|
||||
and then Prj_Path (Last + 1) /= Path_Separator
|
||||
loop
|
||||
Last := Last + 1;
|
||||
end loop;
|
||||
|
||||
if First /= Last or else Project_Path (First) /= '.' then
|
||||
if First /= Last or else Prj_Path (First) /= '.' then
|
||||
|
||||
-- If the directory is ".", skip it as it is the current
|
||||
-- directory and it is already the first directory in the
|
||||
|
|
@ -1758,7 +2203,7 @@ begin
|
|||
Write_Str
|
||||
(Normalize
|
||||
(To_Host_Dir_Spec
|
||||
(Project_Path (First .. Last), True).all));
|
||||
(Prj_Path (First .. Last), True).all));
|
||||
Write_Eol;
|
||||
end if;
|
||||
|
||||
|
|
@ -1778,7 +2223,7 @@ begin
|
|||
|
||||
if not More_Lib_Files then
|
||||
if not Print_Usage and then not Verbose_Mode then
|
||||
if Argument_Count = 0 then
|
||||
if Arg_Count = 1 then
|
||||
Usage;
|
||||
else
|
||||
Try_Help;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1995-2016, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1995-2017, 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- --
|
||||
|
|
@ -366,7 +366,7 @@ package System.OS_Lib is
|
|||
|
||||
type Large_File_Size is range -2**63 .. 2**63 - 1;
|
||||
-- Maximum supported size for a file (8 exabytes = 8 million terabytes,
|
||||
-- should be enough to accomodate all possible needs for quite a while).
|
||||
-- should be enough to accommodate all possible needs for quite a while).
|
||||
|
||||
function File_Length64 (FD : File_Descriptor) return Large_File_Size;
|
||||
pragma Import (C, File_Length64, "__gnat_file_length");
|
||||
|
|
|
|||
|
|
@ -3763,13 +3763,23 @@ package body Sem_Attr is
|
|||
--------------
|
||||
|
||||
when Attribute_Enum_Rep =>
|
||||
-- T'Enum_Rep (X) case
|
||||
|
||||
if Present (E1) then
|
||||
Check_E1;
|
||||
Check_Discrete_Type;
|
||||
Resolve (E1, P_Base_Type);
|
||||
|
||||
elsif not Is_Discrete_Type (Etype (P)) then
|
||||
Error_Attr_P ("prefix of % attribute must be of discrete type");
|
||||
-- X'Enum_Rep case. X must be an object or enumeration literal, and
|
||||
-- it must be of a discrete type.
|
||||
|
||||
elsif not ((Is_Object_Reference (P)
|
||||
or else (Is_Entity_Name (P)
|
||||
and then Ekind (Entity (P)) =
|
||||
E_Enumeration_Literal))
|
||||
and then Is_Discrete_Type (Etype (P)))
|
||||
then
|
||||
Error_Attr_P ("prefix of % attribute must be discrete object");
|
||||
end if;
|
||||
|
||||
Set_Etype (N, Universal_Integer);
|
||||
|
|
|
|||
|
|
@ -8028,7 +8028,7 @@ package body Sem_Ch3 is
|
|||
-- 3. DISCRIMINANTS IN DERIVED UNTAGGED RECORD TYPES
|
||||
|
||||
-- We have spoken about stored discriminants in point 1 (introduction)
|
||||
-- above. There are two sort of stored discriminants: implicit and
|
||||
-- above. There are two sorts of stored discriminants: implicit and
|
||||
-- explicit. As long as the derived type inherits the same discriminants as
|
||||
-- the root record type, stored discriminants are the same as regular
|
||||
-- discriminants, and are said to be implicit. However, if any discriminant
|
||||
|
|
@ -8047,7 +8047,7 @@ package body Sem_Ch3 is
|
|||
-- type T4 (Y : Int) is new T3 (Y, 99);
|
||||
|
||||
-- The following table summarizes the discriminants and stored
|
||||
-- discriminants in R and T1 through T4.
|
||||
-- discriminants in R and T1 through T4:
|
||||
|
||||
-- Type Discrim Stored Discrim Comment
|
||||
-- R (D1, D2, D3) (D1, D2, D3) Girder discrims implicit in R
|
||||
|
|
@ -8058,7 +8058,7 @@ package body Sem_Ch3 is
|
|||
|
||||
-- Field Corresponding_Discriminant (abbreviated CD below) allows us to
|
||||
-- find the corresponding discriminant in the parent type, while
|
||||
-- Original_Record_Component (abbreviated ORC below), the actual physical
|
||||
-- Original_Record_Component (abbreviated ORC below) the actual physical
|
||||
-- component that is renamed. Finally the field Is_Completely_Hidden
|
||||
-- (abbreviated ICH below) is set for all explicit stored discriminants
|
||||
-- (see einfo.ads for more info). For the above example this gives:
|
||||
|
|
@ -8085,10 +8085,10 @@ package body Sem_Ch3 is
|
|||
-- D2 in T3 empty itself yes
|
||||
-- D3 in T3 empty itself yes
|
||||
|
||||
-- Y in T4 X1 in T3 D3 in T3 no
|
||||
-- D1 in T3 empty itself yes
|
||||
-- D2 in T3 empty itself yes
|
||||
-- D3 in T3 empty itself yes
|
||||
-- Y in T4 X1 in T3 D3 in T4 no
|
||||
-- D1 in T4 empty itself yes
|
||||
-- D2 in T4 empty itself yes
|
||||
-- D3 in T4 empty itself yes
|
||||
|
||||
-- 4. DISCRIMINANTS IN DERIVED TAGGED RECORD TYPES
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue