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>
* 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
types.
* sprint.adb (Write_Ureal_With_Col_Check_Sloc): Use square brackets
......
......@@ -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
......
......@@ -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);
......
......@@ -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;
......
......@@ -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
......
......@@ -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
......
......@@ -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).
......
......@@ -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
......
......@@ -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);
......
......@@ -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;
......
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