Commit 199c6a10 by Arnaud Charlet

[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
parent 0ae6242f
2010-09-10 Robert Dewar <dewar@adacore.com> 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 * repinfo.adb (List_Type_Info): List Small and Range for fixed-point
types. types.
* sprint.adb (Write_Ureal_With_Col_Check_Sloc): Use square brackets * sprint.adb (Write_Ureal_With_Col_Check_Sloc): Use square brackets
......
...@@ -4994,7 +4994,10 @@ package body Exp_Ch3 is ...@@ -4994,7 +4994,10 @@ package body Exp_Ch3 is
and then No_Initialization (Expr) and then No_Initialization (Expr)
then then
null; null;
else
-- Otherwise apply a constraint check now if no prev error
elsif Nkind (Expr) /= N_Error then
Apply_Constraint_Check (Expr, Typ); Apply_Constraint_Check (Expr, Typ);
-- If the expression has been marked as requiring a range -- If the expression has been marked as requiring a range
......
...@@ -4096,7 +4096,8 @@ package body Exp_Ch6 is ...@@ -4096,7 +4096,8 @@ package body Exp_Ch6 is
-- Initialize scalar out parameters if Initialize/Normalize_Scalars -- Initialize scalar out parameters if Initialize/Normalize_Scalars
-- Reset Pure indication if any parameter has root type System.Address -- 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 -- Wrap thread body
...@@ -4289,6 +4290,11 @@ package body Exp_Ch6 is ...@@ -4289,6 +4290,11 @@ package body Exp_Ch6 is
F := First_Formal (Spec_Id); F := First_Formal (Spec_Id);
while Present (F) loop while Present (F) loop
if Is_Descendent_Of_Address (Etype (F)) 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)) or else Is_Limited_Type (Etype (F))
then then
Set_Is_Pure (Spec_Id, False); Set_Is_Pure (Spec_Id, False);
......
...@@ -1089,7 +1089,9 @@ package body Freeze is ...@@ -1089,7 +1089,9 @@ package body Freeze is
-- Do not attempt to analyze case where range was in error -- 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; return;
end if; end if;
......
...@@ -4369,6 +4369,14 @@ modifies a global variable (the count). Memo functions are another ...@@ -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 example (where a table of previous calls is kept and consulted to
avoid re-computation). 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 @findex Pure
Note: Most functions in a @code{Pure} package are automatically pure, and 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 there is no need to use pragma @code{Pure_Function} for such functions. One
......
...@@ -685,6 +685,7 @@ package body Prj.Nmsc is ...@@ -685,6 +685,7 @@ package body Prj.Nmsc is
end if; end if;
elsif Prev_Unit /= No_Unit_Index elsif Prev_Unit /= No_Unit_Index
and then Prev_Unit.File_Names (Kind) /= null
and then not Source.Locally_Removed and then not Source.Locally_Removed
then then
-- Path is set if this is a source we found on the disk, in which -- Path is set if this is a source we found on the disk, in which
......
...@@ -1411,6 +1411,14 @@ package body Sem_Aggr is ...@@ -1411,6 +1411,14 @@ package body Sem_Aggr is
-- Set to False if resolution of the expression failed -- Set to False if resolution of the expression failed
begin 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 -- If the array type against which we are resolving the aggregate
-- has several dimensions, the expressions nested inside the -- has several dimensions, the expressions nested inside the
-- aggregate must be further aggregates (or strings). -- aggregate must be further aggregates (or strings).
......
...@@ -11252,6 +11252,12 @@ package body Sem_Ch3 is ...@@ -11252,6 +11252,12 @@ package body Sem_Ch3 is
Rng : Node_Id; Rng : Node_Id;
begin begin
-- Defend against previous errors
if No (Scalar_Range (Derived_Type)) then
return;
end if;
Lo := Build_Scalar_Bound Lo := Build_Scalar_Bound
(Type_Low_Bound (Derived_Type), (Type_Low_Bound (Derived_Type),
Parent_Type, Implicit_Base); Parent_Type, Implicit_Base);
...@@ -18294,6 +18300,12 @@ package body Sem_Ch3 is ...@@ -18294,6 +18300,12 @@ package body Sem_Ch3 is
Kind : constant Entity_Kind := Ekind (Def_Id); Kind : constant Entity_Kind := Ekind (Def_Id);
begin begin
-- Defend against previous error
if Nkind (R) = N_Error then
return;
end if;
Set_Scalar_Range (Def_Id, R); Set_Scalar_Range (Def_Id, R);
-- We need to link the range into the tree before resolving it so -- We need to link the range into the tree before resolving it so
......
...@@ -6413,11 +6413,11 @@ package body Sem_Ch4 is ...@@ -6413,11 +6413,11 @@ package body Sem_Ch4 is
else else
Analyze (Node_To_Replace); Analyze (Node_To_Replace);
-- If the operation has been rewritten into a call, which may -- If the operation has been rewritten into a call, which may get
-- get subsequently an explicit dereference, preserve the -- subsequently an explicit dereference, preserve the type on the
-- type on the original node (selected component or indexed -- original node (selected component or indexed component) for
-- component) for subsequent legality tests, e.g. Is_Variable. -- subsequent legality tests, e.g. Is_Variable. which examines
-- which examines the original node. -- the original node.
if Nkind (Node_To_Replace) = N_Function_Call then if Nkind (Node_To_Replace) = N_Function_Call then
Set_Etype Set_Etype
...@@ -6534,7 +6534,6 @@ package body Sem_Ch4 is ...@@ -6534,7 +6534,6 @@ package body Sem_Ch4 is
and then N = Prefix (Parent_Node) and then N = Prefix (Parent_Node)
then then
Node_To_Replace := Parent_Node; Node_To_Replace := Parent_Node;
Actuals := Expressions (Parent_Node); Actuals := Expressions (Parent_Node);
Actual := First (Actuals); Actual := First (Actuals);
......
...@@ -4680,9 +4680,9 @@ package body Sem_Eval is ...@@ -4680,9 +4680,9 @@ package body Sem_Eval is
-- If there was an error in either range, then just assume the types -- If there was an error in either range, then just assume the types
-- statically match to avoid further junk errors. -- statically match to avoid further junk errors.
if Error_Posted (Scalar_Range (T1)) if No (Scalar_Range (T1)) or else No (Scalar_Range (T2))
or else or else Error_Posted (Scalar_Range (T1))
Error_Posted (Scalar_Range (T2)) or else Error_Posted (Scalar_Range (T2))
then then
return True; return True;
end if; end if;
......
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