From: Arnaud Charlet Date: Mon, 29 Aug 2011 13:48:36 +0000 (+0200) Subject: [multiple changes] X-Git-Tag: releases/gcc-4.7.0~4158 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=ddf67a1d5d44d028c1c90ef16c8f5e1d3c6d102c;p=thirdparty%2Fgcc.git [multiple changes] 2011-08-29 Vincent Celier * 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 * inline.adb (Add_Scopes_To_Clean): Exclude any entity within a generic unit. 2011-08-29 Yannick Moy * exp_ch9.adb: Partial revert of previous change for Alfa mode 2011-08-29 Yannick Moy * exp_ch11.adb: Minor expansion of comment. 2011-08-29 Yannick Moy * lib-xref-alfa.adb (Add_ALFA_Scope): Treat generic entities. 2011-08-29 Ed Schonberg * 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 * 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 * exp_ch7.adb (Build_Raise_Statement): Raise PE instead of the current occurrence. * exp_intr.adb: Minor comment fix. 2011-08-29 Bob Duff * sem_ch13.adb (Analyze_Aspect_Specifications): Fix cases where Delay_Required was used as an uninitialized variable. From-SVN: r178233 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1a078d5f2f4d..42da6aed86d3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,49 @@ +2011-08-29 Vincent Celier + + * 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 + + * inline.adb (Add_Scopes_To_Clean): Exclude any entity within a generic + unit. + +2011-08-29 Yannick Moy + + * exp_ch9.adb: Partial revert of previous change for Alfa mode + +2011-08-29 Yannick Moy + + * exp_ch11.adb: Minor expansion of comment. + +2011-08-29 Yannick Moy + + * lib-xref-alfa.adb (Add_ALFA_Scope): Treat generic entities. + +2011-08-29 Ed Schonberg + + * 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 + + * 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 + + * exp_ch7.adb (Build_Raise_Statement): Raise PE instead of the current + occurrence. + * exp_intr.adb: Minor comment fix. + +2011-08-29 Bob Duff + + * sem_ch13.adb (Analyze_Aspect_Specifications): Fix cases where + Delay_Required was used as an uninitialized variable. + 2011-08-29 Robert Dewar * a-cdlili.adb, a-cdlili.ads, a-coinve.adb, a-coinve.ads, diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 8b391d5e80a0..caf66cca0e02 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -1667,7 +1667,9 @@ package body Exp_Ch11 is else -- Bypass expansion to a run-time call when back-end exception -- 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 and then not CodePeer_Mode diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 2dc78e9d98ac..984bdb869894 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -3104,24 +3104,35 @@ package body Exp_Ch7 is E_Id : Entity_Id; Raised_Id : Entity_Id) return Node_Id is - Proc_Id : Entity_Id; + Stmt : Node_Id; begin -- Standard run-time, .NET/JVM targets + -- Call Raise_From_Controlled_Operation (E_Id). 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 -- Raise_From_Controlled_Operation is not supported. + -- Simply raise Program_Error. else - Proc_Id := RTE (RE_Reraise_Occurrence); + Stmt := + Make_Raise_Program_Error (Loc, + Reason => PE_Finalize_Raised_Exception); + end if; -- Generate: -- if Raised_Id and then not Abort_Id then - -- (); + -- Raise_From_Controlled_Operation (E_Id); -- end if; return @@ -3133,11 +3144,7 @@ package body Exp_Ch7 is Make_Op_Not (Loc, Right_Opnd => New_Reference_To (Abort_Id, Loc))), - Then_Statements => New_List ( - Make_Procedure_Call_Statement (Loc, - Name => New_Reference_To (Proc_Id, Loc), - Parameter_Associations => - New_List (New_Reference_To (E_Id, Loc))))); + Then_Statements => New_List (Stmt)); end Build_Raise_Statement; ----------------------------- diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index b57f3d62e654..57193cbf74f2 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -4878,6 +4878,12 @@ package body Exp_Ch9 is Ldecl2 : Node_Id; begin + -- In formal verification mode, do not expand tasking constructs + + if ALFA_Mode then + return; + end if; + if Expander_Active then -- If we have no handled statement sequence, we may need to build @@ -10571,12 +10577,6 @@ package body Exp_Ch9 is Decl_Stack : Node_Id; begin - -- Do not expand tasking constructs in formal verification mode - - if ALFA_Mode then - return; - end if; - -- If already expanded, nothing to do if Present (Corresponding_Record_Type (Tasktyp)) then diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index ce05b42b30f6..7ce12d61b8ab 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -1232,7 +1232,7 @@ package body Exp_Intr is -- Generate: -- if Raised and then not Abort then - -- Reraise_Occurrence (E); -- for .NET and + -- raise Program_Error; -- for .NET and -- -- restricted RTS -- -- Raise_From_Controlled_Operation (E); -- all other cases diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index ec534e1f3f2d..0eb8dce6f4fe 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -496,8 +496,10 @@ package body Inline is return; end if; - -- If the instance appears within a generic subprogram there is nothing - -- to finalize either. + -- If the instance is within a generic unit, no finalization code + -- 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 S : Entity_Id; @@ -505,7 +507,7 @@ package body Inline is begin S := Scope (Inst); while Present (S) and then S /= Standard_Standard loop - if Is_Generic_Subprogram (S) then + if Is_Generic_Unit (S) then return; end if; diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb index 75dea7f12ec5..9aabe7cf95c9 100644 --- a/gcc/ada/lib-xref-alfa.adb +++ b/gcc/ada/lib-xref-alfa.adb @@ -282,10 +282,10 @@ package body ALFA is end if; case Ekind (E) is - when E_Function => + when E_Function | E_Generic_Function => Typ := 'V'; - when E_Procedure => + when E_Procedure | E_Generic_Procedure => Typ := 'U'; when E_Subprogram_Body => @@ -308,7 +308,7 @@ package body ALFA is end if; end; - when E_Package | E_Package_Body => + when E_Package | E_Package_Body | E_Generic_Package => Typ := 'K'; when E_Void => diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index ce12020bc049..c7e1d070d0f9 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -7373,15 +7373,15 @@ package body Make is end if; - -- Then check if we are dealing with -cargs/-bargs/-largs/-margs - - elsif Argv = "-bargs" - or else - Argv = "-cargs" - or else - Argv = "-largs" - or else - Argv = "-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 + -- Linker of the main project file. + + elsif (And_Save or else Program_Args = None) + and then (Argv = "-bargs" or else + Argv = "-cargs" or else + Argv = "-largs" or else + Argv = "-margs") then case Argv (2) is when 'c' => Program_Args := Compiler; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 6f0b049e8dc5..8df2d05fbf8d 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3528,15 +3528,13 @@ package body Sem_Ch12 is Enclosing_Master := Scope (Enclosing_Master); end if; - elsif Ekind (Enclosing_Master) = E_Generic_Package then - Enclosing_Master := Scope (Enclosing_Master); - - elsif Is_Generic_Subprogram (Enclosing_Master) + elsif Is_Generic_Unit (Enclosing_Master) or else Ekind (Enclosing_Master) = E_Void then -- Cleanup actions will eventually be performed on the - -- enclosing instance, if any. Enclosing scope is void - -- in the formal part of a generic subprogram. + -- enclosing subprogram or package instance, if any. + -- Enclosing scope is void in the formal part of a + -- generic subprogram. exit Scope_Loop; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index fcece69bbfef..5113904ccf95 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -710,7 +710,7 @@ package body Sem_Ch13 is -- or attribute definition node in either case to activate special -- processing (e.g. not traversing the list of homonyms for inline). - Delay_Required : Boolean; + Delay_Required : Boolean := False; -- Set True if delay is required begin @@ -904,7 +904,7 @@ package body Sem_Ch13 is -- Never need to delay for boolean aspects - Delay_Required := False; + pragma Assert (not Delay_Required); -- Library unit aspects. These are boolean aspects, but we -- have to do special things with the insertion, since the @@ -944,7 +944,7 @@ package body Sem_Ch13 is -- If not package declaration, no delay is required - Delay_Required := False; + pragma Assert (not Delay_Required); -- Aspects related to container iterators. These aspects denote -- subprograms, and thus must be delayed. @@ -1046,7 +1046,8 @@ package body Sem_Ch13 is -- to take care of it right away. if Nkind_In (Expr, N_Integer_Literal, N_String_Literal) then - Delay_Required := False; + pragma Assert (not Delay_Required); + null; else Delay_Required := True; Set_Is_Delayed_Aspect (Aspect); @@ -1073,7 +1074,7 @@ package body Sem_Ch13 is -- We don't have to play the delay game here, since the only -- 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 -- the second argument is a local name referring to the entity, @@ -1095,7 +1096,7 @@ package body Sem_Ch13 is -- We don't have to play the delay game here, since the only -- 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 -- are specially handled because they have no corresponding @@ -1146,6 +1147,8 @@ package body Sem_Ch13 is Set_From_Aspect_Specification (Aitem, True); + pragma Assert (not Delay_Required); + when Aspect_Priority | Aspect_Interrupt_Priority => declare Pname : Name_Id; @@ -1164,6 +1167,8 @@ package body Sem_Ch13 is New_List (Relocate_Node (Expr))); Set_From_Aspect_Specification (Aitem, True); + + pragma Assert (not Delay_Required); end; -- Aspects Pre/Post generate Precondition/Postcondition pragmas @@ -1523,7 +1528,7 @@ package body Sem_Ch13 is Prepend (Aitem, To => L); end; - -- For all other cases, insert in sequence + -- For all other cases, insert in sequence when others => Insert_After (Ins_Node, Aitem); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 86c6d3e41561..433678a81b92 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4640,13 +4640,16 @@ package body Sem_Res is -- universal real, since in this case we don't do a conversion to a -- 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) and then Present (Universal_Interpretation (L)) and then Present (Universal_Interpretation (R)) then + Set_Etype (N, B_Typ); Resolve (L, Universal_Interpretation (L)); Resolve (R, Universal_Interpretation (R)); - Set_Etype (N, B_Typ); elsif (B_Typ = Universal_Real or else Etype (N) = Universal_Fixed