Skip to content

R
riscv-gcc-1
Commit 48b351d9 by Arnaud Charlet
Options

[multiple changes] 

2010-06-18  Thomas Quinot  <quinot@adacore.com>

	* g-socket.adb, g-socket.ads (Null_Selector): New object.

2010-06-18  Pascal Obry  <obry@adacore.com>

	* gnat_ugn.texi: Minor clarification.

2010-06-18  Emmanuel Briot  <briot@adacore.com>

	* prj-nmsc.adb (Find_Source_Dirs): Minor refactoring to avoid duplicate
	code when using the project dir as the source dir.
	(Search_Directories): use the normalized name for the source directory,
	where symbolic names have potentially been resolved.

2010-06-18  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Expand_N_Conditional_Expression): Clear Actions field
	when we create N_Expression_With_Actions node.
	(Expand_Short_Circuit): Ditto.

2010-06-18  Robert Dewar  <dewar@adacore.com>

	* exp_util.adb: Minor reformatting.

From-SVN: r160975
parent 6a497607
Showing with 145 additions and 152 deletions
gcc/ada/ChangeLog
2010-06-18 Thomas Quinot <quinot@adacore.com> 2010-06-18 Thomas Quinot <quinot@adacore.com>
* g-socket.adb, g-socket.ads (Null_Selector): New object.
2010-06-18 Pascal Obry <obry@adacore.com>
* gnat_ugn.texi: Minor clarification.
2010-06-18 Emmanuel Briot <briot@adacore.com>
* prj-nmsc.adb (Find_Source_Dirs): Minor refactoring to avoid duplicate
code when using the project dir as the source dir.
(Search_Directories): use the normalized name for the source directory,
where symbolic names have potentially been resolved.
2010-06-18 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Expand_N_Conditional_Expression): Clear Actions field
when we create N_Expression_With_Actions node.
(Expand_Short_Circuit): Ditto.
2010-06-18 Robert Dewar <dewar@adacore.com>
* exp_util.adb: Minor reformatting.
2010-06-18 Thomas Quinot <quinot@adacore.com>
* types.ads: Clean up obsolete comments * types.ads: Clean up obsolete comments
* tbuild.adb: Minor reformatting. * tbuild.adb: Minor reformatting.
* exp_ch5.adb, sem_intr.adb, sem_ch10.adb, rtsfind.adb, s-shasto.adb, * exp_ch5.adb, sem_intr.adb, sem_ch10.adb, rtsfind.adb, s-shasto.adb,
......
gcc/ada/exp_ch4.adb
...@@ -4111,6 +4111,7 @@ package body Exp_Ch4 is ...@@ -4111,6 +4111,7 @@ package body Exp_Ch4 is
Make_Expression_With_Actions (Sloc (Thenx), Make_Expression_With_Actions (Sloc (Thenx),
Actions => Then_Actions (N), Actions => Then_Actions (N),
Expression => Relocate_Node (Thenx))); Expression => Relocate_Node (Thenx)));
Set_Then_Actions (N, No_List);
Analyze_And_Resolve (Thenx, Typ); Analyze_And_Resolve (Thenx, Typ);
end if; end if;
...@@ -4119,6 +4120,7 @@ package body Exp_Ch4 is ...@@ -4119,6 +4120,7 @@ package body Exp_Ch4 is
Make_Expression_With_Actions (Sloc (Elsex), Make_Expression_With_Actions (Sloc (Elsex),
Actions => Else_Actions (N), Actions => Else_Actions (N),
Expression => Relocate_Node (Elsex))); Expression => Relocate_Node (Elsex)));
Set_Else_Actions (N, No_List);
Analyze_And_Resolve (Elsex, Typ); Analyze_And_Resolve (Elsex, Typ);
end if; end if;
...@@ -9044,6 +9046,7 @@ package body Exp_Ch4 is ...@@ -9044,6 +9046,7 @@ package body Exp_Ch4 is
Make_Expression_With_Actions (LocR, Make_Expression_With_Actions (LocR,
Expression => Relocate_Node (Right), Expression => Relocate_Node (Right),
Actions => Actlist)); Actions => Actlist));
Set_Actions (N, No_List);
Analyze_And_Resolve (Right, Standard_Boolean); Analyze_And_Resolve (Right, Standard_Boolean);
end if; end if;
......
gcc/ada/exp_util.adb
...@@ -4685,7 +4685,7 @@ package body Exp_Util is ...@@ -4685,7 +4685,7 @@ package body Exp_Util is
-- If it is a scalar type and we need to capture the value, just make -- If it is a scalar type and we need to capture the value, just make
-- a copy. Likewise for a function call, an attribute reference, an -- a copy. Likewise for a function call, an attribute reference, an
-- allocator or an operator. And if we have a volatile reference and -- allocator, or an operator. And if we have a volatile reference and
-- Name_Req is not set (see comments above for Side_Effect_Free). -- Name_Req is not set (see comments above for Side_Effect_Free).
if Is_Elementary_Type (Exp_Type) if Is_Elementary_Type (Exp_Type)
......
gcc/ada/g-socket.adb
...@@ -273,7 +273,8 @@ package body GNAT.Sockets is ...@@ -273,7 +273,8 @@ package body GNAT.Sockets is
function Is_Open (S : Selector_Type) return Boolean; function Is_Open (S : Selector_Type) return Boolean;
-- Return True for an "open" Selector_Type object, i.e. one for which -- Return True for an "open" Selector_Type object, i.e. one for which
-- Create_Selector has been called and Close_Selector has not been called. -- Create_Selector has been called and Close_Selector has not been called,
-- or the null selector.
--------- ---------
-- "+" -- -- "+" --
...@@ -294,6 +295,10 @@ package body GNAT.Sockets is ...@@ -294,6 +295,10 @@ package body GNAT.Sockets is
begin begin
if not Is_Open (Selector) then if not Is_Open (Selector) then
raise Program_Error with "closed selector"; raise Program_Error with "closed selector";
elsif Selector.Is_Null then
raise Program_Error with "null selector";
end if; end if;
-- Send one byte to unblock select system call -- Send one byte to unblock select system call
...@@ -491,7 +496,7 @@ package body GNAT.Sockets is ...@@ -491,7 +496,7 @@ package body GNAT.Sockets is
is is
Res : C.int; Res : C.int;
Last : C.int; Last : C.int;
RSig : constant Socket_Type := Selector.R_Sig_Socket; RSig : Socket_Type := No_Socket;
TVal : aliased Timeval; TVal : aliased Timeval;
TPtr : Timeval_Access; TPtr : Timeval_Access;
...@@ -511,9 +516,12 @@ package body GNAT.Sockets is ...@@ -511,9 +516,12 @@ package body GNAT.Sockets is
TPtr := TVal'Unchecked_Access; TPtr := TVal'Unchecked_Access;
end if; end if;
-- Add read signalling socket -- Add read signalling socket, if present
if not Selector.Is_Null then
RSig := Selector.R_Sig_Socket;
Set (R_Socket_Set, RSig); Set (R_Socket_Set, RSig);
end if;
Last := C.int'Max (C.int'Max (C.int (R_Socket_Set.Last), Last := C.int'Max (C.int'Max (C.int (R_Socket_Set.Last),
C.int (W_Socket_Set.Last)), C.int (W_Socket_Set.Last)),
...@@ -540,7 +548,7 @@ package body GNAT.Sockets is ...@@ -540,7 +548,7 @@ package body GNAT.Sockets is
-- If Select was resumed because of read signalling socket, read this -- If Select was resumed because of read signalling socket, read this
-- data and remove socket from set. -- data and remove socket from set.
if Is_Set (R_Socket_Set, RSig) then if RSig /= No_Socket and then Is_Set (R_Socket_Set, RSig) then
Clear (R_Socket_Set, RSig); Clear (R_Socket_Set, RSig);
Res := Signalling_Fds.Read (C.int (RSig)); Res := Signalling_Fds.Read (C.int (RSig));
...@@ -585,10 +593,9 @@ package body GNAT.Sockets is ...@@ -585,10 +593,9 @@ package body GNAT.Sockets is
procedure Close_Selector (Selector : in out Selector_Type) is procedure Close_Selector (Selector : in out Selector_Type) is
begin begin
if not Is_Open (Selector) then -- Nothing to do if selector already in closed state
-- Selector already in closed state: nothing to do
if Selector.Is_Null or else not Is_Open (Selector) then
return; return;
end if; end if;
...@@ -1425,6 +1432,10 @@ package body GNAT.Sockets is ...@@ -1425,6 +1432,10 @@ package body GNAT.Sockets is
function Is_Open (S : Selector_Type) return Boolean is function Is_Open (S : Selector_Type) return Boolean is
begin begin
if S.Is_Null then
return True;
else
-- Either both controlling socket descriptors are valid (case of an -- Either both controlling socket descriptors are valid (case of an
-- open selector) or neither (case of a closed selector). -- open selector) or neither (case of a closed selector).
...@@ -1433,6 +1444,7 @@ package body GNAT.Sockets is ...@@ -1433,6 +1444,7 @@ package body GNAT.Sockets is
(S.W_Sig_Socket /= No_Socket)); (S.W_Sig_Socket /= No_Socket));
return S.R_Sig_Socket /= No_Socket; return S.R_Sig_Socket /= No_Socket;
end if;
end Is_Open; end Is_Open;
------------ ------------
......
gcc/ada/g-socket.ads
...@@ -422,6 +422,11 @@ package GNAT.Sockets is ...@@ -422,6 +422,11 @@ package GNAT.Sockets is
type Selector_Access is access all Selector_Type; type Selector_Access is access all Selector_Type;
-- Selector objects are used to wait for i/o events to occur on sockets -- Selector objects are used to wait for i/o events to occur on sockets
Null_Selector : constant Selector_Type;
-- The Null_Selector can be used in place of a normal selector without
-- having to call Create_Selector if the use of Abort_Selector is not
-- required.
-- Timeval_Duration is a subtype of Standard.Duration because the full -- Timeval_Duration is a subtype of Standard.Duration because the full
-- range of Standard.Duration cannot be represented in the equivalent C -- range of Standard.Duration cannot be represented in the equivalent C
-- structure. Moreover, negative values are not allowed to avoid system -- structure. Moreover, negative values are not allowed to avoid system
...@@ -1067,7 +1072,7 @@ package GNAT.Sockets is ...@@ -1067,7 +1072,7 @@ package GNAT.Sockets is
-- the situation where a change to the monitored sockets set must be made. -- the situation where a change to the monitored sockets set must be made.
procedure Create_Selector (Selector : out Selector_Type); procedure Create_Selector (Selector : out Selector_Type);
-- Create a new selector -- Initialize (open) a new selector
procedure Close_Selector (Selector : in out Selector_Type); procedure Close_Selector (Selector : in out Selector_Type);
-- Close Selector and all internal descriptors associated; deallocate any -- Close Selector and all internal descriptors associated; deallocate any
...@@ -1110,7 +1115,8 @@ package GNAT.Sockets is ...@@ -1110,7 +1115,8 @@ package GNAT.Sockets is
-- different objects. -- different objects.
procedure Abort_Selector (Selector : Selector_Type); procedure Abort_Selector (Selector : Selector_Type);
-- Send an abort signal to the selector -- Send an abort signal to the selector. The Selector may not be the
-- Null_Selector.
type Fd_Set is private; type Fd_Set is private;
-- ??? This type must not be used directly, it needs to be visible because -- ??? This type must not be used directly, it needs to be visible because
...@@ -1126,14 +1132,28 @@ private ...@@ -1126,14 +1132,28 @@ private
type Socket_Type is new Integer; type Socket_Type is new Integer;
No_Socket : constant Socket_Type := -1; No_Socket : constant Socket_Type := -1;
type Selector_Type is limited record -- A selector is either a null selector, which is always "open" and can
-- never be aborted, or a regular selector, which is created "closed",
-- becomes "open" when Create_Selector is called, and "closed" again when
-- Close_Selector is called.
type Selector_Type (Is_Null : Boolean := False) is limited record
case Is_Null is
when True =>
null;
when False =>
R_Sig_Socket : Socket_Type := No_Socket; R_Sig_Socket : Socket_Type := No_Socket;
W_Sig_Socket : Socket_Type := No_Socket; W_Sig_Socket : Socket_Type := No_Socket;
-- Signalling sockets used to abort a select operation -- Signalling sockets used to abort a select operation
end case;
end record; end record;
pragma Volatile (Selector_Type); pragma Volatile (Selector_Type);
Null_Selector : constant Selector_Type := (Is_Null => True);
type Fd_Set is type Fd_Set is
new System.Storage_Elements.Storage_Array (1 .. SOSC.SIZEOF_fd_set); new System.Storage_Elements.Storage_Array (1 .. SOSC.SIZEOF_fd_set);
for Fd_Set'Alignment use Interfaces.C.long'Alignment; for Fd_Set'Alignment use Interfaces.C.long'Alignment;
......
gcc/ada/gnat_ugn.texi
...@@ -11549,7 +11549,8 @@ regular files. ...@@ -11549,7 +11549,8 @@ regular files.
@noindent @noindent
One or several Naming Patterns may be given as arguments to @code{gnatname}. One or several Naming Patterns may be given as arguments to @code{gnatname}.
Each Naming Pattern is enclosed between double quotes. Each Naming Pattern is enclosed between double quotes (or single
quotes on Windows).
A Naming Pattern is a regular expression similar to the wildcard patterns A Naming Pattern is a regular expression similar to the wildcard patterns
used in file names by the Unix shells or the DOS prompt. used in file names by the Unix shells or the DOS prompt.
gcc/ada/prj-nmsc.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2000-2009, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2010, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -4790,7 +4790,7 @@ package body Prj.Nmsc is ...@@ -4790,7 +4790,7 @@ package body Prj.Nmsc is
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => Boolean, Element => Boolean,
No_Element => False, No_Element => False,
Key => Name_Id, Key => Path_Name_Type,
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- Hash table stores recursive source directories, to avoid looking -- Hash table stores recursive source directories, to avoid looking
...@@ -4837,36 +4837,24 @@ package body Prj.Nmsc is ...@@ -4837,36 +4837,24 @@ package body Prj.Nmsc is
-- Find one or several source directories, and add (or remove, if -- Find one or several source directories, and add (or remove, if
-- Removed is True) them to list of source directories of the project. -- Removed is True) them to list of source directories of the project.
---------------------- procedure Add_To_Or_Remove_From_Source_Dirs
-- Find_Source_Dirs -- (Path_Id : Path_Name_Type;
---------------------- Display_Path_Id : Path_Name_Type;
procedure Find_Source_Dirs
(From : File_Name_Type;
Location : Source_Ptr;
Rank : Natural; Rank : Natural;
Removed : Boolean := False) Removed : Boolean);
is
Directory : constant String := Get_Name_String (From);
procedure Add_To_Or_Remove_From_List
(Path_Id : Name_Id;
Display_Path_Id : Name_Id);
-- When Removed = False, the directory Path_Id to the list of -- When Removed = False, the directory Path_Id to the list of
-- source_dirs if not already in the list. When Removed = True, -- source_dirs if not already in the list. When Removed = True,
-- removed directory Path_Id if in the list. -- removed directory Path_Id if in the list.
procedure Recursive_Find_Dirs (Path : Name_Id); ---------------------------------------
-- Find all the subdirectories (recursively) of Path and add them -- Add_To_Or_Remove_From_Source_Dirs --
-- to the list of source directories of the project. ---------------------------------------
--------------------------------
-- Add_To_Or_Remove_From_List --
--------------------------------
procedure Add_To_Or_Remove_From_List procedure Add_To_Or_Remove_From_Source_Dirs
(Path_Id : Name_Id; (Path_Id : Path_Name_Type;
Display_Path_Id : Name_Id) Display_Path_Id : Path_Name_Type;
Rank : Natural;
Removed : Boolean)
is is
List : String_List_Id; List : String_List_Id;
Prev : String_List_Id; Prev : String_List_Id;
...@@ -4881,7 +4869,7 @@ package body Prj.Nmsc is ...@@ -4881,7 +4869,7 @@ package body Prj.Nmsc is
Rank_List := Project.Source_Dir_Ranks; Rank_List := Project.Source_Dir_Ranks;
while List /= Nil_String loop while List /= Nil_String loop
Element := Data.Tree.String_Elements.Table (List); Element := Data.Tree.String_Elements.Table (List);
exit when Element.Value = Path_Id; exit when Element.Value = Name_Id (Path_Id);
Prev := List; Prev := List;
List := Element.Next; List := Element.Next;
Prev_Rank := Rank_List; Prev_Rank := Rank_List;
...@@ -4898,9 +4886,9 @@ package body Prj.Nmsc is ...@@ -4898,9 +4886,9 @@ package body Prj.Nmsc is
String_Element_Table.Increment_Last (Data.Tree.String_Elements); String_Element_Table.Increment_Last (Data.Tree.String_Elements);
Element := Element :=
(Value => Path_Id, (Value => Name_Id (Path_Id),
Index => 0, Index => 0,
Display_Value => Display_Path_Id, Display_Value => Name_Id (Display_Path_Id),
Location => No_Location, Location => No_Location,
Flag => False, Flag => False,
Next => Nil_String); Next => Nil_String);
...@@ -4953,7 +4941,23 @@ package body Prj.Nmsc is ...@@ -4953,7 +4941,23 @@ package body Prj.Nmsc is
Data.Tree.Number_Lists.Table (Rank_List).Next; Data.Tree.Number_Lists.Table (Rank_List).Next;
end if; end if;
end if; end if;
end Add_To_Or_Remove_From_List; end Add_To_Or_Remove_From_Source_Dirs;
----------------------
-- Find_Source_Dirs --
----------------------
procedure Find_Source_Dirs
(From : File_Name_Type;
Location : Source_Ptr;
Rank : Natural;
Removed : Boolean := False)
is
Directory : constant String := Get_Name_String (From);
procedure Recursive_Find_Dirs (Path : Name_Id);
-- Find all the subdirectories (recursively) of Path and add them
-- to the list of source directories of the project.
------------------------- -------------------------
-- Recursive_Find_Dirs -- -- Recursive_Find_Dirs --
...@@ -4964,8 +4968,8 @@ package body Prj.Nmsc is ...@@ -4964,8 +4968,8 @@ package body Prj.Nmsc is
Name : String (1 .. 250); Name : String (1 .. 250);
Last : Natural; Last : Natural;
Non_Canonical_Path : Name_Id := No_Name; Non_Canonical_Path : Path_Name_Type := No_Path;
Canonical_Path : Name_Id := No_Name; Canonical_Path : Path_Name_Type := No_Path;
The_Path : constant String := The_Path : constant String :=
Normalize_Pathname Normalize_Pathname
...@@ -4984,7 +4988,8 @@ package body Prj.Nmsc is ...@@ -4984,7 +4988,8 @@ package body Prj.Nmsc is
The_Path (The_Path'First .. The_Path_Last); The_Path (The_Path'First .. The_Path_Last);
Non_Canonical_Path := Name_Find; Non_Canonical_Path := Name_Find;
Canonical_Path := Canonical_Path :=
Name_Id (Canonical_Case_File_Name (Non_Canonical_Path)); Path_Name_Type
(Canonical_Case_File_Name (Name_Id (Non_Canonical_Path)));
-- To avoid processing the same directory several times, check -- To avoid processing the same directory several times, check
-- if the directory is already in Recursive_Dirs. If it is, then -- if the directory is already in Recursive_Dirs. If it is, then
...@@ -4999,9 +5004,11 @@ package body Prj.Nmsc is ...@@ -4999,9 +5004,11 @@ package body Prj.Nmsc is
end if; end if;
end if; end if;
Add_To_Or_Remove_From_List Add_To_Or_Remove_From_Source_Dirs
(Path_Id => Canonical_Path, (Path_Id => Canonical_Path,
Display_Path_Id => Non_Canonical_Path); Display_Path_Id => Non_Canonical_Path,
Rank => Rank,
Removed => Removed);
-- Now look for subdirectories. Do that even when this directory -- Now look for subdirectories. Do that even when this directory
-- is already in the list, because some of its subdirectories may -- is already in the list, because some of its subdirectories may
...@@ -5098,7 +5105,7 @@ package body Prj.Nmsc is ...@@ -5098,7 +5105,7 @@ package body Prj.Nmsc is
Base_Dir : constant File_Name_Type := Name_Find; Base_Dir : constant File_Name_Type := Name_Find;
Root_Dir : constant String := Root_Dir : constant String :=
Normalize_Pathname Normalize_Pathname
(Name => Get_Name_String (Base_Dir), (Name => Name_Buffer (1 .. Name_Len),
Directory => Directory =>
Get_Name_String Get_Name_String
(Project.Directory.Display_Name), (Project.Directory.Display_Name),
...@@ -5109,18 +5116,9 @@ package body Prj.Nmsc is ...@@ -5109,18 +5116,9 @@ package body Prj.Nmsc is
begin begin
if Root_Dir'Length = 0 then if Root_Dir'Length = 0 then
Err_Vars.Error_Msg_File_1 := Base_Dir; Err_Vars.Error_Msg_File_1 := Base_Dir;
if Location = No_Location then
Error_Msg
(Data.Flags,
"{ is not a valid directory.",
Project.Location, Project);
else
Error_Msg Error_Msg
(Data.Flags, (Data.Flags,
"{ is not a valid directory.", "{ is not a valid directory.", Location, Project);
Location, Project);
end if;
else else
-- We have an existing directory, we register it and all of -- We have an existing directory, we register it and all of
...@@ -5158,57 +5156,18 @@ package body Prj.Nmsc is ...@@ -5158,57 +5156,18 @@ package body Prj.Nmsc is
if not Dir_Exists then if not Dir_Exists then
Err_Vars.Error_Msg_File_1 := From; Err_Vars.Error_Msg_File_1 := From;
if Location = No_Location then
Error_Msg
(Data.Flags,
"{ is not a valid directory",
Project.Location, Project);
else
Error_Msg Error_Msg
(Data.Flags, (Data.Flags,
"{ is not a valid directory", "{ is not a valid directory", Location, Project);
Location, Project);
end if;
else else
declare -- links have been resolved if necessary, and Path_Name
Path : constant String := -- always ends with a directory separator
Normalize_Pathname Add_To_Or_Remove_From_Source_Dirs
(Name => (Path_Id => Path_Name.Name,
Get_Name_String (Path_Name.Name), Display_Path_Id => Path_Name.Display_Name,
Directory => Rank => Rank,
Get_Name_String (Project.Directory.Name), Removed => Removed);
Resolve_Links => Opt.Follow_Links_For_Dirs,
Case_Sensitive => True) &
Directory_Separator;
Last_Path : constant Natural :=
Compute_Directory_Last (Path);
Path_Id : Name_Id;
Display_Path : constant String :=
Get_Name_String
(Path_Name.Display_Name);
Last_Display_Path : constant Natural :=
Compute_Directory_Last
(Display_Path);
Display_Path_Id : Name_Id;
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Path (Path'First .. Last_Path));
Path_Id := Name_Find;
Name_Len := 0;
Add_Str_To_Name_Buffer
(Display_Path
(Display_Path'First .. Last_Display_Path));
Display_Path_Id := Name_Find;
Add_To_Or_Remove_From_List
(Path_Id => Path_Id,
Display_Path_Id => Display_Path_Id);
end;
end if; end if;
end; end;
end if; end if;
...@@ -5378,7 +5337,7 @@ package body Prj.Nmsc is ...@@ -5378,7 +5337,7 @@ package body Prj.Nmsc is
pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list"); pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
if (not Source_Files.Default) if not Source_Files.Default
and then Source_Files.Values = Nil_String and then Source_Files.Values = Nil_String
then then
Project.Source_Dirs := Nil_String; Project.Source_Dirs := Nil_String;
...@@ -5391,43 +5350,14 @@ package body Prj.Nmsc is ...@@ -5391,43 +5350,14 @@ package body Prj.Nmsc is
end if; end if;
elsif Source_Dirs.Default then elsif Source_Dirs.Default then
-- No Source_Dirs specified: the single source directory is the one -- No Source_Dirs specified: the single source directory is the one
-- containing the project file. -- containing the project file.
String_Element_Table.Append (Data.Tree.String_Elements, Add_To_Or_Remove_From_Source_Dirs
(Value => Name_Id (Project.Directory.Name), (Path_Id => Project.Directory.Name,
Display_Value => Name_Id (Project.Directory.Display_Name), Display_Path_Id => Project.Directory.Display_Name,
Location => No_Location, Rank => 1,
Flag => False, Removed => False);
Next => Nil_String,
Index => 0));
Project.Source_Dirs :=
String_Element_Table.Last (Data.Tree.String_Elements);
Number_List_Table.Append
(Data.Tree.Number_Lists,
(Number => 1, Next => No_Number_List));
Project.Source_Dir_Ranks :=
Number_List_Table.Last (Data.Tree.Number_Lists);
if Current_Verbosity = High then
Write_Attr
("Default source directory",
Get_Name_String (Project.Directory.Display_Name));
end if;
elsif Source_Dirs.Values = Nil_String then
if Project.Qualifier = Standard then
Error_Msg
(Data.Flags,
"a standard project cannot have no source directories",
Source_Dirs.Location, Project);
end if;
Project.Source_Dirs := Nil_String;
else else
declare declare
...@@ -5446,6 +5376,15 @@ package body Prj.Nmsc is ...@@ -5446,6 +5376,15 @@ package body Prj.Nmsc is
(File_Name_Type (Element.Value), Element.Location, Rank); (File_Name_Type (Element.Value), Element.Location, Rank);
Source_Dir := Element.Next; Source_Dir := Element.Next;
end loop; end loop;
if Project.Source_Dirs = Nil_String
and then Project.Qualifier = Standard
then
Error_Msg
(Data.Flags,
"a standard project cannot have no source directories",
Source_Dirs.Location, Project);
end if;
end; end;
end if; end if;
...@@ -6895,19 +6834,12 @@ package body Prj.Nmsc is ...@@ -6895,19 +6834,12 @@ package body Prj.Nmsc is
Element := Data.Tree.String_Elements.Table (Source_Dir); Element := Data.Tree.String_Elements.Table (Source_Dir);
if Element.Value /= No_Name then if Element.Value /= No_Name then
Get_Name_String (Element.Display_Value);
if Current_Verbosity = High then
Write_Str ("Directory: ");
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Line (Num_Nod.Number'Img);
end if;
declare declare
-- We use Element.Value, not Display_Value, because we want
-- the symbolic links to be resolved when appropriate.
Source_Directory : constant String := Source_Directory : constant String :=
Name_Buffer (1 .. Name_Len) & Get_Name_String (Element.Value)
Directory_Separator; & Directory_Separator;
Dir_Last : constant Natural := Dir_Last : constant Natural :=
Compute_Directory_Last Compute_Directory_Last
(Source_Directory); (Source_Directory);
...@@ -6915,6 +6847,7 @@ package body Prj.Nmsc is ...@@ -6915,6 +6847,7 @@ package body Prj.Nmsc is
begin begin
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Attr ("Source_Dir", Source_Directory); Write_Attr ("Source_Dir", Source_Directory);
Write_Line (Num_Nod.Number'Img);
end if; end if;
-- We look to every entry in the source directory -- We look to every entry in the source directory
...@@ -6964,7 +6897,6 @@ package body Prj.Nmsc is ...@@ -6964,7 +6897,6 @@ package body Prj.Nmsc is
Resolve_Links => Resolve_Links =>
Opt.Follow_Links_For_Files, Opt.Follow_Links_For_Files,
Case_Sensitive => True); Case_Sensitive => True);
-- Case_Sensitive set True (no folding)
Path : Path_Name_Type; Path : Path_Name_Type;
FF : File_Found := Excluded_Sources_Htable.Get FF : File_Found := Excluded_Sources_Htable.Get
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment