Commit 6a2e4f0b by Arnaud Charlet

[multiple changes]

2011-08-01  Robert Dewar  <dewar@adacore.com>

	* make.adb, sem_ch4.adb: Minor reformatting.
	* gcc-interface/Make-lang.in: Update dependencies.
	* sem_util.adb, exp_ch5.adb: Minor reformatting.

2011-08-01  Arnaud Charlet  <charlet@adacore.com>

	* gnat_rm.texi: Fix definition of Long_Integer.

2011-08-01  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb: check limit size of static aggregate unconditionally,
	to prevent storage exhaustion.
	* exp_ch7.adb (Clean_Simple_Protected_Objects): if the scope being
	finalized is a function body, insert the cleanup code before the final
	return statement, to prevent spurious warnings.
	* s-pooglo.ads: add overriding indicator.

From-SVN: r177035
parent 5fcafa60
2011-08-01 Robert Dewar <dewar@adacore.com>
* make.adb, sem_ch4.adb: Minor reformatting.
* gcc-interface/Make-lang.in: Update dependencies.
* sem_util.adb, exp_ch5.adb: Minor reformatting.
2011-08-01 Arnaud Charlet <charlet@adacore.com>
* gnat_rm.texi: Fix definition of Long_Integer.
2011-08-01 Ed Schonberg <schonberg@adacore.com>
* exp_aggr.adb: check limit size of static aggregate unconditionally,
to prevent storage exhaustion.
* exp_ch7.adb (Clean_Simple_Protected_Objects): if the scope being
finalized is a function body, insert the cleanup code before the final
return statement, to prevent spurious warnings.
* s-pooglo.ads: add overriding indicator.
2011-08-01 Ed Schonberg <schonberg@adacore.com> 2011-08-01 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Operator_Check): improve error message when both a * sem_ch4.adb (Operator_Check): improve error message when both a
......
...@@ -6680,8 +6680,9 @@ package body Exp_Aggr is ...@@ -6680,8 +6680,9 @@ package body Exp_Aggr is
elsif Nkind (Expression (Expr)) /= N_Integer_Literal then elsif Nkind (Expression (Expr)) /= N_Integer_Literal then
return False; return False;
end if;
elsif not Aggr_Size_OK (N, Typ) then if not Aggr_Size_OK (N, Typ) then
return False; return False;
end if; end if;
......
...@@ -2767,10 +2767,10 @@ package body Exp_Ch5 is ...@@ -2767,10 +2767,10 @@ package body Exp_Ch5 is
I_Spec : constant Node_Id := Iterator_Specification (Isc); I_Spec : constant Node_Id := Iterator_Specification (Isc);
Id : constant Entity_Id := Defining_Identifier (I_Spec); Id : constant Entity_Id := Defining_Identifier (I_Spec);
Container : constant Node_Id := Name (I_Spec); Container : constant Node_Id := Name (I_Spec);
-- An expression whose type is an array or a predefined container. -- An expression whose type is an array or a predefined container
Typ : constant Entity_Id := Etype (Container); Typ : constant Entity_Id := Etype (Container);
Cursor : Entity_Id; Cursor : Entity_Id;
New_Loop : Node_Id; New_Loop : Node_Id;
......
...@@ -729,15 +729,25 @@ package body Exp_Ch7 is ...@@ -729,15 +729,25 @@ package body Exp_Ch7 is
Ref : constant Node_Id := New_Occurrence_Of (E, Sloc (Stmt)); Ref : constant Node_Id := New_Occurrence_Of (E, Sloc (Stmt));
begin begin
-- If the current context is a function, the end of the
-- statement sequence is likely to be a return statement.
-- The cleanup code must be executed before the return.
if Ekind (Current_Scope) = E_Function
and then Nkind (Stmt) = Sinfo.N_Return_Statement
then
Stmt := Prev (Stmt);
end if;
if Is_Simple_Protected_Type (Typ) then if Is_Simple_Protected_Type (Typ) then
Append_To (Stmts, Cleanup_Protected_Object (N, Ref)); Insert_After (Stmt, Cleanup_Protected_Object (N, Ref));
elsif Has_Simple_Protected_Object (Typ) then elsif Has_Simple_Protected_Object (Typ) then
if Is_Record_Type (Typ) then if Is_Record_Type (Typ) then
Append_List_To (Stmts, Cleanup_Record (N, Ref, Typ)); Insert_List_After (Stmt, Cleanup_Record (N, Ref, Typ));
elsif Is_Array_Type (Typ) then elsif Is_Array_Type (Typ) then
Append_List_To (Stmts, Cleanup_Array (N, Ref, Typ)); Insert_List_After (Stmt, Cleanup_Array (N, Ref, Typ));
end if; end if;
end if; end if;
end; end;
......
...@@ -2274,18 +2274,18 @@ ada/exp_strm.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ...@@ -2274,18 +2274,18 @@ ada/exp_strm.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \ ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
ada/elists.ads ada/exp_strm.ads ada/exp_strm.adb ada/exp_tss.ads \ ada/elists.ads ada/exp_strm.ads ada/exp_strm.adb ada/exp_tss.ads \
ada/get_targ.ads ada/gnat.ads ada/g-htable.ads ada/hostparm.ads \ ada/exp_util.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
ada/lib.ads ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads \ ada/hostparm.ads ada/lib.ads ada/namet.ads ada/nlists.ads \
ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \ ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
ada/rident.ads ada/rtsfind.ads ada/sem_aux.ads ada/sem_util.ads \ ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/sem_aux.ads \
ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \ ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \ ada/snames.ads ada/stand.ads ada/stringt.ads ada/system.ads \
ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \ ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
ada/s-rident.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \ ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-stalib.ads \
ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \ ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \ ada/table.ads ada/table.adb ada/tbuild.ads ada/tbuild.adb \
ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \ ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
ada/unchdeal.ads ada/urealp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads
ada/exp_tss.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/exp_tss.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
...@@ -2409,24 +2409,25 @@ ada/freeze.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ...@@ -2409,24 +2409,25 @@ ada/freeze.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \ ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \ ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \ ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch3.ads ada/exp_ch6.ads \ ada/eval_fat.ads ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch3.ads \
ada/exp_ch7.ads ada/exp_disp.ads ada/exp_pakd.ads ada/exp_tss.ads \ ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_disp.ads ada/exp_pakd.ads \
ada/exp_util.ads ada/exp_util.adb ada/expander.ads ada/fname.ads \ ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb ada/expander.ads \
ada/freeze.ads ada/freeze.adb ada/get_targ.ads ada/gnat.ads \ ada/fname.ads ada/freeze.ads ada/freeze.adb ada/get_targ.ads \
ada/g-hesorg.ads ada/g-htable.ads ada/hostparm.ads ada/inline.ads \ ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/hostparm.ads \
ada/interfac.ads ada/itypes.ads ada/layout.ads ada/lib.ads ada/lib.adb \ ada/inline.ads ada/interfac.ads ada/itypes.ads ada/layout.ads \
ada/lib-list.adb ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads \ ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-sort.adb \
ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \ ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \ ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
ada/rtsfind.ads ada/scans.ads ada/sem.ads ada/sem_aggr.ads \ ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \
ada/sem_attr.ads ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch13.ads \ ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads ada/sem_aux.ads \
ada/sem_ch4.ads ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads \ ada/sem_cat.ads ada/sem_ch13.ads ada/sem_ch4.ads ada/sem_ch6.ads \
ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads ada/sem_elim.ads \ ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \
ada/sem_eval.ads ada/sem_intr.ads ada/sem_mech.ads ada/sem_prag.ads \ ada/sem_elab.ads ada/sem_elim.ads ada/sem_eval.ads ada/sem_eval.adb \
ada/sem_res.ads ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads \ ada/sem_intr.ads ada/sem_mech.ads ada/sem_prag.ads ada/sem_res.ads \
ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \ ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
ada/sinfo-cn.ads ada/sinput.ads ada/snames.ads ada/stand.ads \ ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads \
ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \ ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
ada/stringt.adb ada/style.ads ada/styleg.ads ada/styleg.adb \
ada/stylesw.ads ada/system.ads ada/s-exctab.ads ada/s-exctab.adb \ ada/stylesw.ads ada/system.ads ada/s-exctab.ads ada/s-exctab.adb \
ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \ ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \ ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
......
...@@ -4610,19 +4610,18 @@ pragma Static_Elaboration_Desired; ...@@ -4610,19 +4610,18 @@ pragma Static_Elaboration_Desired;
@end smallexample @end smallexample
@noindent @noindent
This pragma is used to indicate the desire for objects declared in the library This pragma is used to indicate that the compiler should attempt to initialize
unit to which the pragma applies to be initialized statically. This means that statically the objects declared in the library unit to which the pragma applies,
if an object is initialized (either explicitly or by default initialization), when these objects are initialized (explicitly or implicitly) by an aggregate.
then the object's value can be determined at compile time and it requires no In the absence of this pragma, aggregates in object declarations are expanded
code to initialize it. This generally allows the object to be allocated in into assignments and loops, even when the aggregate components are static
read-only data space. A warning is issued if an object or aggregate declared constants. When the aggregate is present the compiler builds a static expression
at the top level of the package cannot be initialized statically. Additionally, that requires no run-time code, so that the initialized object can be placed in
use of this pragma will suppress the generation of loops to initialize named read-only data space. If the components are not static, or the aggregate has
aggregates whose only choice is an others choice that specifies a component more that 100 components, the compiler emits a warning that the pragma cannot
value known at compile time, so that it can be allocated as static data. This be obeyed. (See also the restriction No_Implicit_Loops, which supports static
is limited to aggregates with a maximum of 100 components. (See also the construction of larger aggregates with static components that include an others
restriction No_Implicit_Loops, which supports static allocation for larger choice.)
aggregates.)
@node Pragma Stream_Convert @node Pragma Stream_Convert
@unnumberedsec Pragma Stream_Convert @unnumberedsec Pragma Stream_Convert
...@@ -8097,7 +8096,7 @@ further details. ...@@ -8097,7 +8096,7 @@ further details.
@item Integer @item Integer
32 bit signed 32 bit signed
@item Long_Integer @item Long_Integer
64 bit signed (Alpha OpenVMS only) 64 bit signed (on most 64 bit targets, depending on the C definition of long).
32 bit signed (all other targets) 32 bit signed (all other targets)
@item Long_Long_Integer @item Long_Long_Integer
64 bit signed 64 bit signed
......
...@@ -2933,13 +2933,15 @@ package body Make is ...@@ -2933,13 +2933,15 @@ package body Make is
end if; end if;
-- Make a deep copy of the arguments, because Normalize_Arguments -- Make a deep copy of the arguments, because Normalize_Arguments
-- may deallocate some arguments. -- may deallocate some arguments. Also strip target specific -mxxx
-- Also strip target specific -mxxx switches in CodePeer mode. -- switches in CodePeer mode.
declare declare
Index : Natural := Comp_Next; Index : Natural;
Last : constant Natural := Comp_Last; Last : constant Natural := Comp_Last;
begin begin
Index := Comp_Next;
for J in Comp_Next .. Last loop for J in Comp_Next .. Last loop
declare declare
Str : String renames Args (Arg_Index).all; Str : String renames Args (Arg_Index).all;
......
...@@ -53,7 +53,7 @@ package System.Pool_Global is ...@@ -53,7 +53,7 @@ package System.Pool_Global is
type Unbounded_No_Reclaim_Pool is new type Unbounded_No_Reclaim_Pool is new
System.Storage_Pools.Root_Storage_Pool with null record; System.Storage_Pools.Root_Storage_Pool with null record;
function Storage_Size overriding function Storage_Size
(Pool : Unbounded_No_Reclaim_Pool) (Pool : Unbounded_No_Reclaim_Pool)
return System.Storage_Elements.Storage_Count; return System.Storage_Elements.Storage_Count;
......
...@@ -5691,12 +5691,10 @@ package body Sem_Ch4 is ...@@ -5691,12 +5691,10 @@ package body Sem_Ch4 is
declare declare
U : constant Node_Id := U : constant Node_Id :=
Cunit (Get_Source_Unit (Candidate_Type)); Cunit (Get_Source_Unit (Candidate_Type));
begin begin
if Unit_Is_Visible (U) then if Unit_Is_Visible (U) then
Error_Msg_N -- CODEFIX Error_Msg_N -- CODEFIX
("use clause would make operation legal!", N); ("use clause would make operation legal!", N);
else else
Error_Msg_NE -- CODEFIX Error_Msg_NE -- CODEFIX
("add with_clause and use_clause for&!", ("add with_clause and use_clause for&!",
...@@ -6793,9 +6791,7 @@ package body Sem_Ch4 is ...@@ -6793,9 +6791,7 @@ package body Sem_Ch4 is
-- to same. -- to same.
while Present (Hom) loop while Present (Hom) loop
if (Ekind (Hom) = E_Procedure if Ekind_In (Hom, E_Procedure, E_Function)
or else
Ekind (Hom) = E_Function)
and then not Is_Hidden (Hom) and then not Is_Hidden (Hom)
and then Scope (Hom) = Scope (Anc_Type) and then Scope (Hom) = Scope (Anc_Type)
and then Present (First_Formal (Hom)) and then Present (First_Formal (Hom))
......
...@@ -11553,8 +11553,7 @@ package body Sem_Util is ...@@ -11553,8 +11553,7 @@ package body Sem_Util is
-- Unit_In_Parent_Context -- -- Unit_In_Parent_Context --
---------------------------- ----------------------------
function Unit_In_Parent_Context (Par_Unit : Node_Id) return Boolean function Unit_In_Parent_Context (Par_Unit : Node_Id) return Boolean is
is
begin begin
if Unit_In_Context (Par_Unit) then if Unit_In_Context (Par_Unit) then
return True; return True;
...@@ -11585,8 +11584,8 @@ package body Sem_Util is ...@@ -11585,8 +11584,8 @@ package body Sem_Util is
-- looking for, eg. Text_IO which renames Ada.Text_IO. -- looking for, eg. Text_IO which renames Ada.Text_IO.
elsif elsif
Renamed_Entity (Entity (Name (Clause))) Renamed_Entity (Entity (Name (Clause))) =
= Defining_Entity (Unit (U)) Defining_Entity (Unit (U))
then then
return True; return True;
end if; end if;
...@@ -11594,11 +11593,13 @@ package body Sem_Util is ...@@ -11594,11 +11593,13 @@ package body Sem_Util is
Next (Clause); Next (Clause);
end loop; end loop;
return False; return False;
end Unit_In_Context; end Unit_In_Context;
begin -- Start of processing for Unit_Is_Visible
begin
-- The currrent unit is directly visible. -- The currrent unit is directly visible.
if Curr = U then if Curr = U then
...@@ -11614,7 +11615,6 @@ package body Sem_Util is ...@@ -11614,7 +11615,6 @@ package body Sem_Util is
(Nkind (Unit (Curr)) = N_Subprogram_Body (Nkind (Unit (Curr)) = N_Subprogram_Body
and then not Acts_As_Spec (Unit (Curr))) and then not Acts_As_Spec (Unit (Curr)))
then then
if Unit_In_Context (Library_Unit (Curr)) then if Unit_In_Context (Library_Unit (Curr)) 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