[multiple changes]

2010-09-10  Robert Dewar  <dewar@adacore.com>

	* sem_ch4.adb: Minor reformatting.
	* exp_ch6.adb: Add comment on testing limited on full type
	* gnat_rm.texi: Add documentation on Pure_Function.

2010-09-10  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Add_Source): Allow an Ada source to have the same name
	as a source of another project and of another language.

2010-09-10  Robert Dewar  <dewar@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration): Defend against previous
	errors.
	* freeze.adb (Check_Unsigned_Type): Ditto.
	* sem_aggr.adb (Resolve_Aggr_Expr): Ditto.
	* sem_ch3.adb (Convert_Scalar_Bounds): Ditto.
	(Set_Scalar_Range_For_Subtype): Ditto.
	* sem_eval.adb (Subtypes_Statically_Match): Ditto.

From-SVN: r164170
This commit is contained in:
Arnaud Charlet 2010-09-10 15:12:08 +02:00
parent 0ae6242fed
commit 199c6a1000
10 changed files with 72 additions and 12 deletions

View File

@ -1,3 +1,24 @@
2010-09-10 Robert Dewar <dewar@adacore.com>
* sem_ch4.adb: Minor reformatting.
* exp_ch6.adb: Add comment on testing limited on full type
* gnat_rm.texi: Add documentation on Pure_Function.
2010-09-10 Vincent Celier <celier@adacore.com>
* prj-nmsc.adb (Add_Source): Allow an Ada source to have the same name
as a source of another project and of another language.
2010-09-10 Robert Dewar <dewar@adacore.com>
* exp_ch3.adb (Expand_N_Object_Declaration): Defend against previous
errors.
* freeze.adb (Check_Unsigned_Type): Ditto.
* sem_aggr.adb (Resolve_Aggr_Expr): Ditto.
* sem_ch3.adb (Convert_Scalar_Bounds): Ditto.
(Set_Scalar_Range_For_Subtype): Ditto.
* sem_eval.adb (Subtypes_Statically_Match): Ditto.
2010-09-10 Robert Dewar <dewar@adacore.com>
* repinfo.adb (List_Type_Info): List Small and Range for fixed-point

View File

@ -4994,7 +4994,10 @@ package body Exp_Ch3 is
and then No_Initialization (Expr)
then
null;
else
-- Otherwise apply a constraint check now if no prev error
elsif Nkind (Expr) /= N_Error then
Apply_Constraint_Check (Expr, Typ);
-- If the expression has been marked as requiring a range

View File

@ -4096,7 +4096,8 @@ package body Exp_Ch6 is
-- Initialize scalar out parameters if Initialize/Normalize_Scalars
-- Reset Pure indication if any parameter has root type System.Address
-- or has any parameters of limited types.
-- or has any parameters of limited types, where limited means that the
-- run-time view is limited (i.e. the full type is limited).
-- Wrap thread body
@ -4289,6 +4290,11 @@ package body Exp_Ch6 is
F := First_Formal (Spec_Id);
while Present (F) loop
if Is_Descendent_Of_Address (Etype (F))
-- Note that this test is being made in the body of the
-- subprogram, not the spec, so we are testing the full
-- type for being limited here, as required.
or else Is_Limited_Type (Etype (F))
then
Set_Is_Pure (Spec_Id, False);

View File

@ -1089,7 +1089,9 @@ package body Freeze is
-- Do not attempt to analyze case where range was in error
if Error_Posted (Scalar_Range (E)) then
if No (Scalar_Range (E))
or else Error_Posted (Scalar_Range (E))
then
return;
end if;

View File

@ -4369,6 +4369,14 @@ modifies a global variable (the count). Memo functions are another
example (where a table of previous calls is kept and consulted to
avoid re-computation).
Note also that the normal rules excluding optimization of subprograms
in pure units (when parameter types are descended from System.Address,
or when the full view of a parameter type is limited), do not apply
for the Pure_Function case. If you explicitly specify Pure_Function,
the compiler may optimize away calls with identical arguments, and
if that results in unexpected behavior, the proper action is not to
use the pragma for subprograms that are not (conceptually) pure.
@findex Pure
Note: Most functions in a @code{Pure} package are automatically pure, and
there is no need to use pragma @code{Pure_Function} for such functions. One

View File

@ -685,6 +685,7 @@ package body Prj.Nmsc is
end if;
elsif Prev_Unit /= No_Unit_Index
and then Prev_Unit.File_Names (Kind) /= null
and then not Source.Locally_Removed
then
-- Path is set if this is a source we found on the disk, in which

View File

@ -1411,6 +1411,14 @@ package body Sem_Aggr is
-- Set to False if resolution of the expression failed
begin
-- Defend against previous errors
if Nkind (Expr) = N_Error
or else Error_Posted (Expr)
then
return True;
end if;
-- If the array type against which we are resolving the aggregate
-- has several dimensions, the expressions nested inside the
-- aggregate must be further aggregates (or strings).

View File

@ -11252,6 +11252,12 @@ package body Sem_Ch3 is
Rng : Node_Id;
begin
-- Defend against previous errors
if No (Scalar_Range (Derived_Type)) then
return;
end if;
Lo := Build_Scalar_Bound
(Type_Low_Bound (Derived_Type),
Parent_Type, Implicit_Base);
@ -18294,6 +18300,12 @@ package body Sem_Ch3 is
Kind : constant Entity_Kind := Ekind (Def_Id);
begin
-- Defend against previous error
if Nkind (R) = N_Error then
return;
end if;
Set_Scalar_Range (Def_Id, R);
-- We need to link the range into the tree before resolving it so

View File

@ -6413,11 +6413,11 @@ package body Sem_Ch4 is
else
Analyze (Node_To_Replace);
-- If the operation has been rewritten into a call, which may
-- get subsequently an explicit dereference, preserve the
-- type on the original node (selected component or indexed
-- component) for subsequent legality tests, e.g. Is_Variable.
-- which examines the original node.
-- If the operation has been rewritten into a call, which may get
-- subsequently an explicit dereference, preserve the type on the
-- original node (selected component or indexed component) for
-- subsequent legality tests, e.g. Is_Variable. which examines
-- the original node.
if Nkind (Node_To_Replace) = N_Function_Call then
Set_Etype
@ -6534,7 +6534,6 @@ package body Sem_Ch4 is
and then N = Prefix (Parent_Node)
then
Node_To_Replace := Parent_Node;
Actuals := Expressions (Parent_Node);
Actual := First (Actuals);

View File

@ -4680,9 +4680,9 @@ package body Sem_Eval is
-- If there was an error in either range, then just assume the types
-- statically match to avoid further junk errors.
if Error_Posted (Scalar_Range (T1))
or else
Error_Posted (Scalar_Range (T2))
if No (Scalar_Range (T1)) or else No (Scalar_Range (T2))
or else Error_Posted (Scalar_Range (T1))
or else Error_Posted (Scalar_Range (T2))
then
return True;
end if;