Commit 33374829 by Arnaud Charlet

[multiple changes]

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

	* sem_elim.adb (Check_Eliminated): Handle new improved eliminate
	information: no need for full scope check.
	(Eliminate_Error): Do not emit error in a generic context.

2009-04-29  Ed Falis  <falis@adacore.com>

	* adaint.c (__gnat_rmdir): return error code if VTHREADS is defined.
	VxWorks 653 POS does not support rmdir.

2009-04-29  Matteo Bordin  <bordin@adacore.com>

	* s-stausa.adb, s-stausa.ads: Get_Usage_Range: changing the way
	results are printed.

From-SVN: r146943
parent 91c2cbdb
2009-04-29 Ed Schonberg <schonberg@adacore.com>
* sem_elim.adb (Check_Eliminated): Handle new improved eliminate
information: no need for full scope check.
(Eliminate_Error): Do not emit error in a generic context.
2009-04-29 Ed Falis <falis@adacore.com>
* adaint.c (__gnat_rmdir): return error code if VTHREADS is defined.
VxWorks 653 POS does not support rmdir.
2009-04-29 Matteo Bordin <bordin@adacore.com>
* s-stausa.adb, s-stausa.ads: Get_Usage_Range: changing the way
results are printed.
2009-04-29 Arnaud Charlet <charlet@adacore.com> 2009-04-29 Arnaud Charlet <charlet@adacore.com>
* s-taskin.adb (Initialize): Remove pragma Warnings Off and remove * s-taskin.adb (Initialize): Remove pragma Warnings Off and remove
......
...@@ -747,6 +747,9 @@ __gnat_rmdir (char *path) ...@@ -747,6 +747,9 @@ __gnat_rmdir (char *path)
S2WSC (wpath, path, GNAT_MAX_PATH_LEN); S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
return _trmdir (wpath); return _trmdir (wpath);
} }
#elif defined (VTHREADS)
/* rmdir not available */
return -1;
#else #else
return rmdir (path); return rmdir (path);
#endif #endif
......
...@@ -173,7 +173,7 @@ package body System.Stack_Usage is ...@@ -173,7 +173,7 @@ package body System.Stack_Usage is
Index_Str : constant String := "Index"; Index_Str : constant String := "Index";
Task_Name_Str : constant String := "Task Name"; Task_Name_Str : constant String := "Task Name";
Stack_Size_Str : constant String := "Stack Size"; Stack_Size_Str : constant String := "Stack Size";
Actual_Size_Str : constant String := "Stack usage [Value +/- Variation]"; Actual_Size_Str : constant String := "Stack usage";
function Get_Usage_Range (Result : Task_Result) return String; function Get_Usage_Range (Result : Task_Result) return String;
-- Return string representing the range of possible result of stack usage -- Return string representing the range of possible result of stack usage
...@@ -203,10 +203,10 @@ package body System.Stack_Usage is ...@@ -203,10 +203,10 @@ package body System.Stack_Usage is
Result_Array := new Result_Array_Type (1 .. Buffer_Size); Result_Array := new Result_Array_Type (1 .. Buffer_Size);
Result_Array.all := Result_Array.all :=
(others => (others =>
(Task_Name => (others => ASCII.NUL), (Task_Name => (others => ASCII.NUL),
Variation => 0, Variation => 0,
Value => 0, Value => 0,
Max_Size => 0)); Max_Size => 0));
-- Set the Is_Enabled flag to true, so that the task wrapper knows that -- Set the Is_Enabled flag to true, so that the task wrapper knows that
-- it has to handle dynamic stack analysis -- it has to handle dynamic stack analysis
...@@ -327,12 +327,11 @@ package body System.Stack_Usage is ...@@ -327,12 +327,11 @@ package body System.Stack_Usage is
-- Initialize the analyzer fields -- Initialize the analyzer fields
Analyzer.Bottom_Of_Stack := Bottom; Analyzer.Bottom_Of_Stack := Bottom;
Analyzer.Stack_Size := My_Stack_Size; Analyzer.Stack_Size := My_Stack_Size;
Analyzer.Pattern_Size := Max_Pattern_Size; Analyzer.Pattern_Size := Max_Pattern_Size;
Analyzer.Pattern := Pattern; Analyzer.Pattern := Pattern;
Analyzer.Result_Id := Next_Id; Analyzer.Result_Id := Next_Id;
Analyzer.Task_Name := (others => ' ');
Analyzer.Task_Name := (others => ' ');
-- Compute the task name, and truncate if bigger than Task_Name_Length -- Compute the task name, and truncate if bigger than Task_Name_Length
...@@ -415,10 +414,11 @@ package body System.Stack_Usage is ...@@ -415,10 +414,11 @@ package body System.Stack_Usage is
function Get_Usage_Range (Result : Task_Result) return String is function Get_Usage_Range (Result : Task_Result) return String is
Variation_Used_Str : constant String := Variation_Used_Str : constant String :=
Natural'Image (Result.Variation); Natural'Image (Result.Variation);
Value_Used_Str : constant String := Natural'Image (Result.Value); Value_Used_Str : constant String :=
Natural'Image (Result.Value);
begin begin
return "[" & Value_Used_Str & " +/- " & Variation_Used_Str & "]"; return Value_Used_Str & " +/- " & Variation_Used_Str;
end Get_Usage_Range; end Get_Usage_Range;
--------------------- ---------------------
...@@ -488,8 +488,8 @@ package body System.Stack_Usage is ...@@ -488,8 +488,8 @@ package body System.Stack_Usage is
for J in Result_Array'Range loop for J in Result_Array'Range loop
exit when J >= Next_Id; exit when J >= Next_Id;
if Result_Array (J).Value if Result_Array (J).Value >
> Result_Array (Max_Actual_Use_Result_Id).Value Result_Array (Max_Actual_Use_Result_Id).Value
then then
Max_Actual_Use_Result_Id := J; Max_Actual_Use_Result_Id := J;
end if; end if;
...@@ -569,15 +569,18 @@ package body System.Stack_Usage is ...@@ -569,15 +569,18 @@ package body System.Stack_Usage is
begin begin
if Analyzer.Pattern_Size = 0 then if Analyzer.Pattern_Size = 0 then
-- If we have that result, it means that we didn't do any computation -- If we have that result, it means that we didn't do any computation
-- at all. In other words, we used at least everything (and possibly -- at all. In other words, we used at least everything (and possibly
-- more). -- more).
Min := Analyzer.Stack_Size - Overflow_Guard; Min := Analyzer.Stack_Size - Overflow_Guard;
Max := Analyzer.Stack_Size; Max := Analyzer.Stack_Size;
else else
Min := Stack_Size Min :=
(Analyzer.Topmost_Touched_Mark, Analyzer.Bottom_Of_Stack); Stack_Size
(Analyzer.Topmost_Touched_Mark, Analyzer.Bottom_Of_Stack);
Max := Min + Overflow_Guard; Max := Min + Overflow_Guard;
end if; end if;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1997-2008, Free Software Foundation, Inc. -- -- Copyright (C) 1997-2009, 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- --
...@@ -26,6 +26,7 @@ ...@@ -26,6 +26,7 @@
with Atree; use Atree; with Atree; use Atree;
with Einfo; use Einfo; with Einfo; use Einfo;
with Errout; use Errout; with Errout; use Errout;
with Lib; use Lib;
with Namet; use Namet; with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Sem; use Sem; with Sem; use Sem;
...@@ -234,29 +235,6 @@ package body Sem_Elim is ...@@ -234,29 +235,6 @@ package body Sem_Elim is
Scop : Entity_Id; Scop : Entity_Id;
Form : Entity_Id; Form : Entity_Id;
function Original_Chars (S : Entity_Id) return Name_Id;
-- If the candidate subprogram is a protected operation of a single
-- protected object, the scope of the operation is the created
-- protected type, and we have to retrieve the original name of
-- the object.
--------------------
-- Original_Chars --
--------------------
function Original_Chars (S : Entity_Id) return Name_Id is
begin
if Ekind (S) /= E_Protected_Type
or else Comes_From_Source (S)
then
return Chars (S);
else
return Chars (Defining_Identifier (Original_Node (Parent (S))));
end if;
end Original_Chars;
-- Start of processing for Check_Eliminated
begin begin
if No_Elimination then if No_Elimination then
return; return;
...@@ -308,33 +286,9 @@ package body Sem_Elim is ...@@ -308,33 +286,9 @@ package body Sem_Elim is
goto Continue; goto Continue;
end if; end if;
-- Then we need to see if the static scope matches within the -- Find enclosing unit.
-- compilation unit.
-- At the moment, gnatelim does not consider block statements as
-- scopes (even if a block is named)
Scop := Scope (E); Scop := Cunit_Entity (Current_Sem_Unit);
while Ekind (Scop) = E_Block loop
Scop := Scope (Scop);
end loop;
if Elmt.Entity_Scope /= null then
for J in reverse Elmt.Entity_Scope'Range loop
if Elmt.Entity_Scope (J) /= Original_Chars (Scop) then
goto Continue;
end if;
Scop := Scope (Scop);
while Ekind (Scop) = E_Block loop
Scop := Scope (Scop);
end loop;
if not Is_Compilation_Unit (Scop) and then J = 1 then
goto Continue;
end if;
end loop;
end if;
-- Now see if compilation unit matches -- Now see if compilation unit matches
...@@ -673,7 +627,10 @@ package body Sem_Elim is ...@@ -673,7 +627,10 @@ package body Sem_Elim is
Enclosing_Subp : Entity_Id; Enclosing_Subp : Entity_Id;
begin begin
if Is_Eliminated (Ultimate_Subp) and then not Inside_A_Generic then if Is_Eliminated (Ultimate_Subp)
and then not Inside_A_Generic
and then not Is_Generic_Unit (Cunit_Entity (Current_Sem_Unit))
then
Enclosing_Subp := Current_Subprogram; Enclosing_Subp := Current_Subprogram;
while Present (Enclosing_Subp) loop while Present (Enclosing_Subp) loop
if Is_Eliminated (Enclosing_Subp) then if Is_Eliminated (Enclosing_Subp) then
...@@ -701,9 +658,21 @@ package body Sem_Elim is ...@@ -701,9 +658,21 @@ package body Sem_Elim is
end if; end if;
end loop; end loop;
-- Should never fall through, since entry should be in table -- If this is an internal operation generated for a protected operation.
-- its name does not match the source name, so just report the error.
if not Comes_From_Source (E)
and then Present (First_Entity (E))
and then Is_Concurrent_Record_Type (Etype (First_Entity (E)))
then
Error_Msg_NE
("cannot reference eliminated protected subprogram", N, E);
raise Program_Error; -- Otherwise should not fall through, entry should be in table
else
raise Program_Error;
end if;
end Eliminate_Error_Msg; end Eliminate_Error_Msg;
---------------- ----------------
......
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