Commit 76e776e5 by Arnaud Charlet

[multiple changes]

2009-04-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Actuals): Do not create blocks around code
	statements, even though the actual of the call is a concatenation,
	because the argument is static, and we want to preserve warning
	messages  about sequences of code statements that are not marked
	volatile.

	* sem_warn.adb: remove obsolete comment about warning being obsolete

	* s-tasren.adb (Task_Do_Or_Queue): If a timed entry call is being
	requeued and the delay has expired while within the accept statement
	that executes the requeue, do not perform the requeue and indicate that
	the timed call has been aborted.

2009-04-24  Emmanuel Briot  <briot@adacore.com>

	* mlib-prj.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-env.adb
	(Has_Ada_Sources, Has_Foreign_Sources): new subprograms
	(Project_Data.Ada_Sources_Present, Foreign_Sources_Present): removed,
	since they can be computed from the above.

From-SVN: r146698
parent e3dd53ec
2009-04-24 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Actuals): Do not create blocks around code
statements, even though the actual of the call is a concatenation,
because the argument is static, and we want to preserve warning
messages about sequences of code statements that are not marked
volatile.
* sem_warn.adb: remove obsolete comment about warning being obsolete
* s-tasren.adb (Task_Do_Or_Queue): If a timed entry call is being
requeued and the delay has expired while within the accept statement
that executes the requeue, do not perform the requeue and indicate that
the timed call has been aborted.
2009-04-24 Emmanuel Briot <briot@adacore.com>
* mlib-prj.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-env.adb
(Has_Ada_Sources, Has_Foreign_Sources): new subprograms
(Project_Data.Ada_Sources_Present, Foreign_Sources_Present): removed,
since they can be computed from the above.
2009-04-24 Vincent Celier <celier@adacore.com>
* gnatcmd.adb: Call Prj.Env.Initialize with the Project_Tree
......
......@@ -1351,7 +1351,7 @@ package body MLib.Prj is
In_Main_Object_Directory := True;
There_Are_Foreign_Sources := Data.Other_Sources_Present;
There_Are_Foreign_Sources := Has_Foreign_Sources (Data);
loop
if Data.Object_Directory /= No_Path_Information then
......
......@@ -1563,7 +1563,7 @@ package body Prj.Env is
-- If there are Ada sources, call action with the name of every
-- source directory.
if In_Tree.Projects.Table (Project).Ada_Sources_Present then
if Has_Ada_Sources (In_Tree.Projects.Table (Project)) then
while Current /= Nil_String loop
The_String := In_Tree.String_Elements.Table (Current);
Action (Get_Name_String (The_String.Display_Value));
......
......@@ -4348,9 +4348,6 @@ package body Prj.Nmsc is
-- Shouldn't these be set to False by default, and only set to True when
-- we actually find some source file???
Data.Ada_Sources_Present := Data.Source_Dirs /= Nil_String;
Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String;
if Data.Source_Dirs /= Nil_String then
-- Check if languages are specified in this project
......@@ -4396,13 +4393,6 @@ package body Prj.Nmsc is
Data.Languages.Config.Kind := Unit_Based;
Data.Languages.Config.Dependency_Kind :=
ALI_File;
-- Attribute Languages is not specified. So, it defaults to
-- a project of language Ada only. No sources of languages
-- other than Ada.
Data.Other_Sources_Present := False;
else
Data.Languages.Config.Kind := File_Based;
end if;
......@@ -4417,11 +4407,6 @@ package body Prj.Nmsc is
NL_Id : Language_Ptr;
begin
-- Assume there are no languages declared
Data.Ada_Sources_Present := False;
Data.Other_Sources_Present := False;
-- If there are no languages declared, there are no sources
if Current = Nil_String then
......@@ -4455,18 +4440,6 @@ package body Prj.Nmsc is
end loop;
if NL_Id = No_Language_Index then
if Get_Mode = Ada_Only then
-- Check for language Ada
if Lang_Name = Name_Ada then
Data.Ada_Sources_Present := True;
else
Data.Other_Sources_Present := True;
end if;
end if;
Index := new Language_Data'(No_Language_Data);
Index.Name := Lang_Name;
Index.Display_Name := Element.Value;
......@@ -7096,10 +7069,6 @@ package body Prj.Nmsc is
Name : File_Name_Type;
begin
if Get_Mode = Ada_Only then
Data.Ada_Sources_Present := Current /= Nil_String;
end if;
if Get_Mode = Multi_Language then
if Current = Nil_String then
Data.Languages := No_Language_Index;
......@@ -7292,7 +7261,7 @@ package body Prj.Nmsc is
then
-- We should have found at least one source, if not report an error
if Data.Ada_Sources = Nil_String then
if not Has_Ada_Sources (Data) then
Report_No_Sources
(Project, "Ada", In_Tree, Source_List_File.Location);
end if;
......
......@@ -104,8 +104,6 @@ package body Prj is
Lib_Auto_Init => False,
Libgnarl_Needed => Unknown,
Symbol_Data => No_Symbols,
Ada_Sources_Present => True,
Other_Sources_Present => True,
Ada_Sources => Nil_String,
Interfaces_Defined => False,
Imported_Directories_Switches => null,
......@@ -1184,6 +1182,42 @@ package body Prj is
raise Constraint_Error;
end Value;
---------------------
-- Has_Ada_Sources --
---------------------
function Has_Ada_Sources (Data : Project_Data) return Boolean is
Lang : Language_Ptr := Data.Languages;
begin
while Lang /= No_Language_Index loop
if Lang.Name = Name_Ada then
return Lang.First_Source /= No_Source;
end if;
Lang := Lang.Next;
end loop;
return False;
end Has_Ada_Sources;
-------------------------
-- Has_Foreign_Sources --
-------------------------
function Has_Foreign_Sources (Data : Project_Data) return Boolean is
Lang : Language_Ptr := Data.Languages;
begin
while Lang /= No_Language_Index loop
if Lang.Name /= Name_Ada
and then Lang.First_Source /= No_Source
then
return True;
end if;
Lang := Lang.Next;
end loop;
return False;
end Has_Foreign_Sources;
begin
-- Make sure that the standard config and user project file extensions are
-- compatible with canonical case file naming.
......
......@@ -1239,12 +1239,6 @@ package Prj is
-- In multi-language mode, the sources for all languages including Ada
-- are accessible through the Source_Iterator type
Ada_Sources_Present : Boolean := True;
-- True if there are Ada sources in the project
Other_Sources_Present : Boolean := True;
-- True if there are non-Ada sources in the project
Ada_Sources : String_List_Id := Nil_String;
-- The list of all the Ada source file names (gnatmake only).
......@@ -1350,6 +1344,12 @@ package Prj is
-- Return True when Language_Name (which must be lower case) is one of the
-- languages used for the project.
function Has_Ada_Sources (Data : Project_Data) return Boolean;
-- Return True if the project has Ada sources
function Has_Foreign_Sources (Data : Project_Data) return Boolean;
-- Return True if the project has foreign sources
Project_Error : exception;
-- Raised by some subprograms in Prj.Attr
......@@ -1417,8 +1417,9 @@ package Prj is
Equal => "=");
-- Mapping of file names to indexes in the Units table
type Private_Project_Tree_Data is private;
-- Data for a project tree that is used only by the Project Manager
---------------------
-- Source_Iterator --
---------------------
type Source_Iterator is private;
......@@ -1435,6 +1436,13 @@ package Prj is
procedure Next (Iter : in out Source_Iterator);
-- Move on to the next source
-----------------------
-- Project_Tree_Data --
-----------------------
type Private_Project_Tree_Data is private;
-- Data for a project tree that is used only by the Project Manager
type Project_Tree_Data is
record
Name_Lists : Name_List_Table.Instance;
......
......@@ -1225,9 +1225,31 @@ package body System.Tasking.Rendezvous is
-- we would not have gotten this far, so now we should
-- (re)enqueue the call, if the mode permits that.
if Entry_Call.Mode /= Conditional_Call
or else not Entry_Call.With_Abort
-- If the call is timed, it may have timed out before the requeue,
-- in the unusual case where the current accept has taken longer than
-- the given delay. In that case the requeue is cancelled, and the
-- outer timed call will be aborted.
if Entry_Call.Mode = Conditional_Call
or else
(Entry_Call.Mode = Timed_Call
and then Entry_Call.With_Abort
and then Entry_Call.Cancellation_Attempted)
then
STPO.Unlock (Acceptor);
if Parent_Locked then
STPO.Unlock (Parent);
end if;
STPO.Write_Lock (Entry_Call.Self);
pragma Assert (Entry_Call.State >= Was_Abortable);
Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Cancelled);
STPO.Unlock (Entry_Call.Self);
else
-- Timed_Call, Simple_Call, or Asynchronous_Call
Queuing.Enqueue (Acceptor.Entry_Queues (E), Entry_Call);
......@@ -1266,22 +1288,6 @@ package body System.Tasking.Rendezvous is
STPO.Unlock (Entry_Call.Self);
end if;
else
-- Conditional_Call and With_Abort
STPO.Unlock (Acceptor);
if Parent_Locked then
STPO.Unlock (Parent);
end if;
STPO.Write_Lock (Entry_Call.Self);
pragma Assert (Entry_Call.State >= Was_Abortable);
Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Cancelled);
STPO.Unlock (Entry_Call.Self);
end if;
return True;
......
......@@ -3173,11 +3173,17 @@ package body Sem_Res is
-- A small optimization: if one of the actuals is a concatenation
-- create a block around a procedure call to recover stack space.
-- This alleviates stack usage when several procedure calls in
-- the same statement list use concatenation.
-- the same statement list use concatenation. We do not perform
-- this wrapping for code statements, where the argument is a
-- static string, and we want to preserve warnings involving
-- sequences of such statements.
elsif Nkind (A) = N_Op_Concat
and then Nkind (N) = N_Procedure_Call_Statement
and then Expander_Active
and then
not (Is_Intrinsic_Subprogram (Nam)
and then Chars (Nam) = Name_Asm)
then
Establish_Transient_Scope (A, False);
Resolve (A, Etype (F));
......
......@@ -213,16 +213,6 @@ package body Sem_Warn is
-- Check multiple code statements in a row
-- Note: the following code is now unreachable, because Asm statements
-- are procedure calls whose actuals are concatenations, and as a result
-- of a recent stack usage optimization each such call has its own
-- block.
-- Are they always concatenations??? if so why not remove this code???
-- And indeed if we are really losing this warning, that's really bad
-- and we need to put it back ???
if Is_List_Member (N)
and then Present (Prev (N))
and then Nkind (Prev (N)) = N_Code_Statement
......
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