diff options
Diffstat (limited to 'gcc/ada/sem_ch5.adb')
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 156 |
1 files changed, 1 insertions, 155 deletions
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 99a5757..f917486 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -113,7 +113,7 @@ package body Sem_Ch5 is procedure Analyze_Assignment (N : Node_Id) is Lhs : constant Node_Id := Name (N); - Rhs : Node_Id := Expression (N); + Rhs : constant Node_Id := Expression (N); procedure Diagnose_Non_Variable_Lhs (N : Node_Id); -- N is the node for the left hand side of an assignment, and it is not @@ -137,27 +137,6 @@ package body Sem_Ch5 is -- nominal subtype. This procedure is used to deal with cases where the -- nominal subtype must be replaced by the actual subtype. - procedure Transform_BIP_Assignment (Typ : Entity_Id); - function Should_Transform_BIP_Assignment - (Typ : Entity_Id) return Boolean; - -- If the right-hand side of an assignment statement is a build-in-place - -- call we cannot build in place, so we insert a temp initialized with - -- the call, and transform the assignment statement to copy the temp. - -- Transform_BIP_Assignment does the transformation, and - -- Should_Transform_BIP_Assignment determines whether we should. - -- The same goes for qualified expressions and conversions whose - -- operand is such a call. - -- - -- This is only for nonlimited types; assignment statements are illegal - -- for limited types, but are generated internally for aggregates and - -- init procs. These limited-type are not really assignment statements - -- -- conceptually, they are initializations, so should not be - -- transformed. - -- - -- Similarly, for nonlimited types, aggregates and init procs generate - -- assignment statements that are really initializations. These are - -- marked No_Ctrl_Actions. - function Within_Function return Boolean; -- Determine whether the current scope is a function or appears within -- one. @@ -354,87 +333,6 @@ package body Sem_Ch5 is end if; end Set_Assignment_Type; - ------------------------------------- - -- Should_Transform_BIP_Assignment -- - ------------------------------------- - - function Should_Transform_BIP_Assignment - (Typ : Entity_Id) return Boolean - is - begin - if Expander_Active - and then not Is_Limited_View (Typ) - and then Is_Build_In_Place_Result_Type (Typ) - and then not No_Ctrl_Actions (N) - then - -- This function is called early, before name resolution is - -- complete, so we have to deal with things that might turn into - -- function calls later. N_Function_Call and N_Op nodes are the - -- obvious case. An N_Identifier or N_Expanded_Name is a - -- parameterless function call if it denotes a function. - -- Finally, an attribute reference can be a function call. - - declare - Unqual_Rhs : constant Node_Id := Unqual_Conv (Rhs); - begin - case Nkind (Unqual_Rhs) is - when N_Function_Call - | N_Op - => - return True; - - when N_Expanded_Name - | N_Identifier - => - return - Ekind (Entity (Unqual_Rhs)) in E_Function | E_Operator; - - -- T'Input will turn into a call whose result type is T - - when N_Attribute_Reference => - return Attribute_Name (Unqual_Rhs) = Name_Input; - - when others => - return False; - end case; - end; - else - return False; - end if; - end Should_Transform_BIP_Assignment; - - ------------------------------ - -- Transform_BIP_Assignment -- - ------------------------------ - - procedure Transform_BIP_Assignment (Typ : Entity_Id) is - - -- Tranform "X : [constant] T := F (...);" into: - -- - -- Temp : constant T := F (...); - -- X := Temp; - - Loc : constant Source_Ptr := Sloc (N); - Def_Id : constant Entity_Id := Make_Temporary (Loc, 'Y', Rhs); - Obj_Decl : constant Node_Id := - Make_Object_Declaration (Loc, - Defining_Identifier => Def_Id, - Constant_Present => True, - Object_Definition => New_Occurrence_Of (Typ, Loc), - Expression => Rhs, - Has_Init_Expression => True); - - begin - Set_Etype (Def_Id, Typ); - Set_Expression (N, New_Occurrence_Of (Def_Id, Loc)); - - -- At this point, Rhs is no longer equal to Expression (N), so: - - Rhs := Expression (N); - - Insert_Action (N, Obj_Decl); - end Transform_BIP_Assignment; - --------------------- -- Within_Function -- --------------------- @@ -610,56 +508,6 @@ package body Sem_Ch5 is end if; end if; - -- Deal with build-in-place calls for nonlimited types. We don't do this - -- later, because resolving the rhs tranforms it incorrectly for build- - -- in-place. - - if Should_Transform_BIP_Assignment (Typ => T1) then - - -- In certain cases involving user-defined concatenation operators, - -- we need to resolve the right-hand side before transforming the - -- assignment. - - case Nkind (Unqual_Conv (Rhs)) is - when N_Function_Call => - declare - Actual : Node_Id := - First (Parameter_Associations (Unqual_Conv (Rhs))); - Actual_Exp : Node_Id; - - begin - while Present (Actual) loop - if Nkind (Actual) = N_Parameter_Association then - Actual_Exp := Explicit_Actual_Parameter (Actual); - else - Actual_Exp := Actual; - end if; - - if Nkind (Actual_Exp) = N_Op_Concat then - Resolve (Rhs, T1); - exit; - end if; - - Next (Actual); - end loop; - end; - - when N_Attribute_Reference - | N_Expanded_Name - | N_Identifier - | N_Op - => - null; - - when others => - raise Program_Error; - end case; - - Transform_BIP_Assignment (Typ => T1); - end if; - - pragma Assert (not Should_Transform_BIP_Assignment (Typ => T1)); - -- The resulting assignment type is T1, so now we will resolve the left -- hand side of the assignment using this determined type. @@ -1303,8 +1151,6 @@ package body Sem_Ch5 is Full_Analysis := Save_Full_Analysis; Current_Assignment := Empty; end if; - - pragma Assert (not Should_Transform_BIP_Assignment (Typ => T1)); end if; end Analyze_Assignment; |