Commit ddf67a1d by Arnaud Charlet

[multiple changes]

2011-08-29  Vincent Celier  <celier@adacore.com>

	* make.adb (Scan_Make_Arg): Take any option as is in packages Compiler,
	Binder or Linker of the main project file.

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

	* inline.adb (Add_Scopes_To_Clean): Exclude any entity within a generic
	unit.

2011-08-29  Yannick Moy  <moy@adacore.com>

	* exp_ch9.adb: Partial revert of previous change for Alfa mode

2011-08-29  Yannick Moy  <moy@adacore.com>

	* exp_ch11.adb: Minor expansion of comment.

2011-08-29  Yannick Moy  <moy@adacore.com>

	* lib-xref-alfa.adb (Add_ALFA_Scope): Treat generic entities.

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

	* sem_res.adb (Resolve_Arithmetic_Op): If the node has a universal
	interpretation, set the type before resolving the operands, because
	legality checks on an exponention operand need to know the type of the
	context.

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

	* sem_ch12.adb (Analyze_Package_Instantiation): Do not set delayed
	cleanups on a master if the instance is within a generic unit.
	Complement to the corresponding fix to inline.adb for K520-030.

2011-08-29  Tristan Gingold  <gingold@adacore.com>

	* exp_ch7.adb (Build_Raise_Statement): Raise PE instead of the current
	occurrence.
	* exp_intr.adb: Minor comment fix.

2011-08-29  Bob Duff  <duff@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications): Fix cases where
	Delay_Required was used as an uninitialized variable.

From-SVN: r178233
parent 690943fc
2011-08-29 Vincent Celier <celier@adacore.com>
* make.adb (Scan_Make_Arg): Take any option as is in packages Compiler,
Binder or Linker of the main project file.
2011-08-29 Ed Schonberg <schonberg@adacore.com>
* inline.adb (Add_Scopes_To_Clean): Exclude any entity within a generic
unit.
2011-08-29 Yannick Moy <moy@adacore.com>
* exp_ch9.adb: Partial revert of previous change for Alfa mode
2011-08-29 Yannick Moy <moy@adacore.com>
* exp_ch11.adb: Minor expansion of comment.
2011-08-29 Yannick Moy <moy@adacore.com>
* lib-xref-alfa.adb (Add_ALFA_Scope): Treat generic entities.
2011-08-29 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Arithmetic_Op): If the node has a universal
interpretation, set the type before resolving the operands, because
legality checks on an exponention operand need to know the type of the
context.
2011-08-29 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Analyze_Package_Instantiation): Do not set delayed
cleanups on a master if the instance is within a generic unit.
Complement to the corresponding fix to inline.adb for K520-030.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb (Build_Raise_Statement): Raise PE instead of the current
occurrence.
* exp_intr.adb: Minor comment fix.
2011-08-29 Bob Duff <duff@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specifications): Fix cases where
Delay_Required was used as an uninitialized variable.
2011-08-29 Robert Dewar <dewar@adacore.com> 2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.adb, a-cdlili.ads, a-coinve.adb, a-coinve.ads, * a-cdlili.adb, a-cdlili.ads, a-coinve.adb, a-coinve.ads,
......
...@@ -1667,7 +1667,9 @@ package body Exp_Ch11 is ...@@ -1667,7 +1667,9 @@ package body Exp_Ch11 is
else else
-- Bypass expansion to a run-time call when back-end exception -- Bypass expansion to a run-time call when back-end exception
-- handling is active, unless the target is a VM, CodePeer or -- handling is active, unless the target is a VM, CodePeer or
-- GNATprove. -- GNATprove. In CodePeer, raising an exception is treated as an
-- error, while in GNATprove all code with exceptions falls outside
-- the subset of code which can be formally analyzed.
if VM_Target = No_VM if VM_Target = No_VM
and then not CodePeer_Mode and then not CodePeer_Mode
......
...@@ -3104,24 +3104,35 @@ package body Exp_Ch7 is ...@@ -3104,24 +3104,35 @@ package body Exp_Ch7 is
E_Id : Entity_Id; E_Id : Entity_Id;
Raised_Id : Entity_Id) return Node_Id Raised_Id : Entity_Id) return Node_Id
is is
Proc_Id : Entity_Id; Stmt : Node_Id;
begin begin
-- Standard run-time, .NET/JVM targets -- Standard run-time, .NET/JVM targets
-- Call Raise_From_Controlled_Operation (E_Id).
if RTE_Available (RE_Raise_From_Controlled_Operation) then if RTE_Available (RE_Raise_From_Controlled_Operation) then
Proc_Id := RTE (RE_Raise_From_Controlled_Operation); Stmt :=
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (RTE (RE_Raise_From_Controlled_Operation),
Loc),
Parameter_Associations =>
New_List (New_Reference_To (E_Id, Loc)));
-- Restricted runtime: exception messages are not supported and hence -- Restricted runtime: exception messages are not supported and hence
-- Raise_From_Controlled_Operation is not supported. -- Raise_From_Controlled_Operation is not supported.
-- Simply raise Program_Error.
else else
Proc_Id := RTE (RE_Reraise_Occurrence); Stmt :=
Make_Raise_Program_Error (Loc,
Reason => PE_Finalize_Raised_Exception);
end if; end if;
-- Generate: -- Generate:
-- if Raised_Id and then not Abort_Id then -- if Raised_Id and then not Abort_Id then
-- <Proc_Id> (<Params>); -- Raise_From_Controlled_Operation (E_Id);
-- end if; -- end if;
return return
...@@ -3133,11 +3144,7 @@ package body Exp_Ch7 is ...@@ -3133,11 +3144,7 @@ package body Exp_Ch7 is
Make_Op_Not (Loc, Make_Op_Not (Loc,
Right_Opnd => New_Reference_To (Abort_Id, Loc))), Right_Opnd => New_Reference_To (Abort_Id, Loc))),
Then_Statements => New_List ( Then_Statements => New_List (Stmt));
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (Proc_Id, Loc),
Parameter_Associations =>
New_List (New_Reference_To (E_Id, Loc)))));
end Build_Raise_Statement; end Build_Raise_Statement;
----------------------------- -----------------------------
......
...@@ -4878,6 +4878,12 @@ package body Exp_Ch9 is ...@@ -4878,6 +4878,12 @@ package body Exp_Ch9 is
Ldecl2 : Node_Id; Ldecl2 : Node_Id;
begin begin
-- In formal verification mode, do not expand tasking constructs
if ALFA_Mode then
return;
end if;
if Expander_Active then if Expander_Active then
-- If we have no handled statement sequence, we may need to build -- If we have no handled statement sequence, we may need to build
...@@ -10571,12 +10577,6 @@ package body Exp_Ch9 is ...@@ -10571,12 +10577,6 @@ package body Exp_Ch9 is
Decl_Stack : Node_Id; Decl_Stack : Node_Id;
begin begin
-- Do not expand tasking constructs in formal verification mode
if ALFA_Mode then
return;
end if;
-- If already expanded, nothing to do -- If already expanded, nothing to do
if Present (Corresponding_Record_Type (Tasktyp)) then if Present (Corresponding_Record_Type (Tasktyp)) then
......
...@@ -1232,7 +1232,7 @@ package body Exp_Intr is ...@@ -1232,7 +1232,7 @@ package body Exp_Intr is
-- Generate: -- Generate:
-- if Raised and then not Abort then -- if Raised and then not Abort then
-- Reraise_Occurrence (E); -- for .NET and -- raise Program_Error; -- for .NET and
-- -- restricted RTS -- -- restricted RTS
-- <or> -- <or>
-- Raise_From_Controlled_Operation (E); -- all other cases -- Raise_From_Controlled_Operation (E); -- all other cases
......
...@@ -496,8 +496,10 @@ package body Inline is ...@@ -496,8 +496,10 @@ package body Inline is
return; return;
end if; end if;
-- If the instance appears within a generic subprogram there is nothing -- If the instance is within a generic unit, no finalization code
-- to finalize either. -- can be generated. Note that at this point all bodies have been
-- analyzed, and the scope stack itself is not present, and the flag
-- Inside_A_Generic is not set.
declare declare
S : Entity_Id; S : Entity_Id;
...@@ -505,7 +507,7 @@ package body Inline is ...@@ -505,7 +507,7 @@ package body Inline is
begin begin
S := Scope (Inst); S := Scope (Inst);
while Present (S) and then S /= Standard_Standard loop while Present (S) and then S /= Standard_Standard loop
if Is_Generic_Subprogram (S) then if Is_Generic_Unit (S) then
return; return;
end if; end if;
......
...@@ -282,10 +282,10 @@ package body ALFA is ...@@ -282,10 +282,10 @@ package body ALFA is
end if; end if;
case Ekind (E) is case Ekind (E) is
when E_Function => when E_Function | E_Generic_Function =>
Typ := 'V'; Typ := 'V';
when E_Procedure => when E_Procedure | E_Generic_Procedure =>
Typ := 'U'; Typ := 'U';
when E_Subprogram_Body => when E_Subprogram_Body =>
...@@ -308,7 +308,7 @@ package body ALFA is ...@@ -308,7 +308,7 @@ package body ALFA is
end if; end if;
end; end;
when E_Package | E_Package_Body => when E_Package | E_Package_Body | E_Generic_Package =>
Typ := 'K'; Typ := 'K';
when E_Void => when E_Void =>
......
...@@ -7373,15 +7373,15 @@ package body Make is ...@@ -7373,15 +7373,15 @@ package body Make is
end if; end if;
-- Then check if we are dealing with -cargs/-bargs/-largs/-margs -- Then check if we are dealing with -cargs/-bargs/-largs/-margs. These
-- options are taken as is when found in package Compiler, Binder or
elsif Argv = "-bargs" -- Linker of the main project file.
or else
Argv = "-cargs" elsif (And_Save or else Program_Args = None)
or else and then (Argv = "-bargs" or else
Argv = "-largs" Argv = "-cargs" or else
or else Argv = "-largs" or else
Argv = "-margs" Argv = "-margs")
then then
case Argv (2) is case Argv (2) is
when 'c' => Program_Args := Compiler; when 'c' => Program_Args := Compiler;
......
...@@ -3528,15 +3528,13 @@ package body Sem_Ch12 is ...@@ -3528,15 +3528,13 @@ package body Sem_Ch12 is
Enclosing_Master := Scope (Enclosing_Master); Enclosing_Master := Scope (Enclosing_Master);
end if; end if;
elsif Ekind (Enclosing_Master) = E_Generic_Package then elsif Is_Generic_Unit (Enclosing_Master)
Enclosing_Master := Scope (Enclosing_Master);
elsif Is_Generic_Subprogram (Enclosing_Master)
or else Ekind (Enclosing_Master) = E_Void or else Ekind (Enclosing_Master) = E_Void
then then
-- Cleanup actions will eventually be performed on the -- Cleanup actions will eventually be performed on the
-- enclosing instance, if any. Enclosing scope is void -- enclosing subprogram or package instance, if any.
-- in the formal part of a generic subprogram. -- Enclosing scope is void in the formal part of a
-- generic subprogram.
exit Scope_Loop; exit Scope_Loop;
......
...@@ -710,7 +710,7 @@ package body Sem_Ch13 is ...@@ -710,7 +710,7 @@ package body Sem_Ch13 is
-- or attribute definition node in either case to activate special -- or attribute definition node in either case to activate special
-- processing (e.g. not traversing the list of homonyms for inline). -- processing (e.g. not traversing the list of homonyms for inline).
Delay_Required : Boolean; Delay_Required : Boolean := False;
-- Set True if delay is required -- Set True if delay is required
begin begin
...@@ -904,7 +904,7 @@ package body Sem_Ch13 is ...@@ -904,7 +904,7 @@ package body Sem_Ch13 is
-- Never need to delay for boolean aspects -- Never need to delay for boolean aspects
Delay_Required := False; pragma Assert (not Delay_Required);
-- Library unit aspects. These are boolean aspects, but we -- Library unit aspects. These are boolean aspects, but we
-- have to do special things with the insertion, since the -- have to do special things with the insertion, since the
...@@ -944,7 +944,7 @@ package body Sem_Ch13 is ...@@ -944,7 +944,7 @@ package body Sem_Ch13 is
-- If not package declaration, no delay is required -- If not package declaration, no delay is required
Delay_Required := False; pragma Assert (not Delay_Required);
-- Aspects related to container iterators. These aspects denote -- Aspects related to container iterators. These aspects denote
-- subprograms, and thus must be delayed. -- subprograms, and thus must be delayed.
...@@ -1046,7 +1046,8 @@ package body Sem_Ch13 is ...@@ -1046,7 +1046,8 @@ package body Sem_Ch13 is
-- to take care of it right away. -- to take care of it right away.
if Nkind_In (Expr, N_Integer_Literal, N_String_Literal) then if Nkind_In (Expr, N_Integer_Literal, N_String_Literal) then
Delay_Required := False; pragma Assert (not Delay_Required);
null;
else else
Delay_Required := True; Delay_Required := True;
Set_Is_Delayed_Aspect (Aspect); Set_Is_Delayed_Aspect (Aspect);
...@@ -1073,7 +1074,7 @@ package body Sem_Ch13 is ...@@ -1073,7 +1074,7 @@ package body Sem_Ch13 is
-- We don't have to play the delay game here, since the only -- We don't have to play the delay game here, since the only
-- values are check names which don't get analyzed anyway. -- values are check names which don't get analyzed anyway.
Delay_Required := False; pragma Assert (not Delay_Required);
-- Aspects corresponding to pragmas with two arguments, where -- Aspects corresponding to pragmas with two arguments, where
-- the second argument is a local name referring to the entity, -- the second argument is a local name referring to the entity,
...@@ -1095,7 +1096,7 @@ package body Sem_Ch13 is ...@@ -1095,7 +1096,7 @@ package body Sem_Ch13 is
-- We don't have to play the delay game here, since the only -- We don't have to play the delay game here, since the only
-- values are ON/OFF which don't get analyzed anyway. -- values are ON/OFF which don't get analyzed anyway.
Delay_Required := False; pragma Assert (not Delay_Required);
-- Default_Value and Default_Component_Value aspects. These -- Default_Value and Default_Component_Value aspects. These
-- are specially handled because they have no corresponding -- are specially handled because they have no corresponding
...@@ -1146,6 +1147,8 @@ package body Sem_Ch13 is ...@@ -1146,6 +1147,8 @@ package body Sem_Ch13 is
Set_From_Aspect_Specification (Aitem, True); Set_From_Aspect_Specification (Aitem, True);
pragma Assert (not Delay_Required);
when Aspect_Priority | Aspect_Interrupt_Priority => declare when Aspect_Priority | Aspect_Interrupt_Priority => declare
Pname : Name_Id; Pname : Name_Id;
...@@ -1164,6 +1167,8 @@ package body Sem_Ch13 is ...@@ -1164,6 +1167,8 @@ package body Sem_Ch13 is
New_List (Relocate_Node (Expr))); New_List (Relocate_Node (Expr)));
Set_From_Aspect_Specification (Aitem, True); Set_From_Aspect_Specification (Aitem, True);
pragma Assert (not Delay_Required);
end; end;
-- Aspects Pre/Post generate Precondition/Postcondition pragmas -- Aspects Pre/Post generate Precondition/Postcondition pragmas
...@@ -1523,7 +1528,7 @@ package body Sem_Ch13 is ...@@ -1523,7 +1528,7 @@ package body Sem_Ch13 is
Prepend (Aitem, To => L); Prepend (Aitem, To => L);
end; end;
-- For all other cases, insert in sequence -- For all other cases, insert in sequence
when others => when others =>
Insert_After (Ins_Node, Aitem); Insert_After (Ins_Node, Aitem);
......
...@@ -4640,13 +4640,16 @@ package body Sem_Res is ...@@ -4640,13 +4640,16 @@ package body Sem_Res is
-- universal real, since in this case we don't do a conversion to a -- universal real, since in this case we don't do a conversion to a
-- specific fixed-point type (instead the expander handles the case). -- specific fixed-point type (instead the expander handles the case).
-- Set the type of the node to its universal interpretation because
-- legality checks on an exponentiation operand need the context.
elsif (B_Typ = Universal_Integer or else B_Typ = Universal_Real) elsif (B_Typ = Universal_Integer or else B_Typ = Universal_Real)
and then Present (Universal_Interpretation (L)) and then Present (Universal_Interpretation (L))
and then Present (Universal_Interpretation (R)) and then Present (Universal_Interpretation (R))
then then
Set_Etype (N, B_Typ);
Resolve (L, Universal_Interpretation (L)); Resolve (L, Universal_Interpretation (L));
Resolve (R, Universal_Interpretation (R)); Resolve (R, Universal_Interpretation (R));
Set_Etype (N, B_Typ);
elsif (B_Typ = Universal_Real elsif (B_Typ = Universal_Real
or else Etype (N) = Universal_Fixed or else Etype (N) = Universal_Fixed
......
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