From abcd9db2c8326a00f5d08d7ce08a382eb9b17120 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 3 Aug 2011 09:45:36 +0200 Subject: [PATCH] [multiple changes] 2011-08-03 Robert Dewar * exp_ch4.adb (Optimize_Length_Check): Fix bad handling of case where comparison operand is variable, and turns out to be zero or negative. 2011-08-03 Javier Miranda * exp_intr.adb (Expand_Dispatching_Constructor_Call): Disable expansion of code required for native targets. Done to avoid generating references to unavailable runtime entities in VM targets. * exp_ch3.adb (Expand_N_Object_Declaration): Add missing support to handle the explicit initialization of class-wide interface objects. Fix documentation. 2011-08-03 Matthew Heaney * a-cobove.adb (Merge): Move source onto target, instead of using Assign 2011-08-03 Matthew Heaney * a-cbdlli.adb (Splice): move source items from first to last 2011-08-03 Yannick Moy * sem_util.ads: comment added. 2011-08-03 Javier Miranda * exp_aggr.adb (Expand_Record_Aggregate): In VM targets disable the expansion into assignments of aggregates whose type is not known at compile time. From-SVN: r177233 --- gcc/ada/ChangeLog | 34 ++++++++++++++++++++++++++++++++++ gcc/ada/a-cbdlli.adb | 9 ++++----- gcc/ada/a-cobove.adb | 4 ++-- gcc/ada/exp_aggr.adb | 6 ++++-- gcc/ada/exp_ch3.adb | 38 +++++++++++++++++++++++++++++--------- gcc/ada/exp_ch4.adb | 16 ++++++++-------- gcc/ada/exp_intr.adb | 3 ++- gcc/ada/sem_util.ads | 17 +++++++++-------- 8 files changed, 92 insertions(+), 35 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2612b177fc8..64dd7442b5e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,37 @@ +2011-08-03 Robert Dewar + + * exp_ch4.adb (Optimize_Length_Check): Fix bad handling of case where + comparison operand is variable, and turns out to be zero or negative. + +2011-08-03 Javier Miranda + + * exp_intr.adb + (Expand_Dispatching_Constructor_Call): Disable expansion of + code required for native targets. Done to avoid generating + references to unavailable runtime entities in VM targets. + * exp_ch3.adb + (Expand_N_Object_Declaration): Add missing support to handle + the explicit initialization of class-wide interface objects. + Fix documentation. + +2011-08-03 Matthew Heaney + + * a-cobove.adb (Merge): Move source onto target, instead of using Assign + +2011-08-03 Matthew Heaney + + * a-cbdlli.adb (Splice): move source items from first to last + +2011-08-03 Yannick Moy + + * sem_util.ads: comment added. + +2011-08-03 Javier Miranda + + * exp_aggr.adb + (Expand_Record_Aggregate): In VM targets disable the expansion into + assignments of aggregates whose type is not known at compile time. + 2011-08-03 Ed Schonberg * exp_ch9.adb (Build_Renamed_Formal_Declaration): common procedure for diff --git a/gcc/ada/a-cbdlli.adb b/gcc/ada/a-cbdlli.adb index 2dd8a5c879d..61615a0c89b 100644 --- a/gcc/ada/a-cbdlli.adb +++ b/gcc/ada/a-cbdlli.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1486,10 +1486,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is "attempt to tamper with cursors of Source (list is busy)"; end if; - loop - Insert (Target, Before, Source.Nodes (Source.Last).Element); - Delete_Last (Source); - exit when Is_Empty (Source); + while not Is_Empty (Source) loop + Insert (Target, Before, Source.Nodes (Source.First).Element); + Delete_First (Source); end loop; end Splice; diff --git a/gcc/ada/a-cobove.adb b/gcc/ada/a-cobove.adb index 759bab44599..eaef697d36c 100644 --- a/gcc/ada/a-cobove.adb +++ b/gcc/ada/a-cobove.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -762,7 +762,7 @@ package body Ada.Containers.Bounded_Vectors is begin if Target.Is_Empty then - Target.Assign (Source); + Move (Target => Target, Source => Source); return; end if; diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 536b317cab8..079db9c9564 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -5649,7 +5649,9 @@ package body Exp_Aggr is -- Gigi doesn't handle properly temporaries of variable size -- so we generate it in the front-end - elsif not Size_Known_At_Compile_Time (Typ) then + elsif not Size_Known_At_Compile_Time (Typ) + and then Tagged_Type_Expansion + then Convert_To_Assignments (N, Typ); -- Temporaries for controlled aggregates need to be attached to a diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 540d3952787..fc999c6d4d6 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -4477,14 +4477,6 @@ package body Exp_Ch3 is -- Expand_N_Object_Declaration -- --------------------------------- - -- First we do special processing for objects of a tagged type where this - -- is the point at which the type is frozen. The creation of the dispatch - -- table and the initialization procedure have to be deferred to this - -- point, since we reference previously declared primitive subprograms. - - -- The above comment is in the wrong place, it should be at the proper - -- point in this routine ??? - procedure Expand_N_Object_Declaration (N : Node_Id) is Def_Id : constant Entity_Id := Defining_Identifier (N); Expr : constant Node_Id := Expression (N); @@ -4528,6 +4520,12 @@ package body Exp_Ch3 is return; end if; + -- First we do special processing for objects of a tagged type where + -- this is the point at which the type is frozen. The creation of the + -- dispatch table and the initialization procedure have to be deferred + -- to this point, since we reference previously declared primitive + -- subprograms. + -- Force construction of dispatch tables of library level tagged types if Tagged_Type_Expansion @@ -4993,11 +4991,33 @@ package body Exp_Ch3 is Set_Homonym (Defining_Identifier (N), Homonym (Def_Id)); Exchange_Entities (Defining_Identifier (N), Def_Id); end; + + -- Handle initialization of class-wide interface object in VM + -- targets + + elsif not Tagged_Type_Expansion then + + -- Replace + -- CW : I'Class := Obj; + -- by + -- CW : I'Class; + -- CW := I'Class (Obj); [1] + + -- The assignment [1] is later expanded in a dispatching + -- call to _assign + + Set_Expression (N, Empty); + + Insert_Action (N, + Make_Assignment_Statement (Loc, + Name => New_Reference_To (Def_Id, Loc), + Expression => Convert_To (Typ, + Relocate_Node (Expr)))); end if; return; - -- Comment needed here, what case is this??? + -- Common case of explicit object initialization else -- In most cases, we must check that the initial value meets any diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index abaf676b148..0298487256e 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -10209,11 +10209,11 @@ package body Exp_Ch4 is -- Kind of comparison operator, gets flipped if operands backwards function Is_Optimizable (N : Node_Id) return Boolean; - -- Tests N to see if it is an optimizable comparison value (defined - -- as constant zero or one, or something else where the value is known - -- to be in range of 32-bits, and where the corresponding Length value - -- is also known to be 32-bits. If result is true, sets Is_Zero, Ityp, - -- and Comp accordingly. + -- Tests N to see if it is an optimizable comparison value (defined as + -- constant zero or one, or something else where the value is known to + -- be positive and in the range of 32-bits, and where the corresponding + -- Length value is also known to be 32-bits. If result is true, sets + -- Is_Zero, Ityp, and Comp accordingly. function Is_Entity_Length (N : Node_Id) return Boolean; -- Tests if N is a length attribute applied to a simple entity. If so, @@ -10293,14 +10293,14 @@ package body Exp_Ch4 is Determine_Range (N, OK, Lo, Hi, Assume_Valid => True); if not OK - or else Lo < UI_From_Int (Int'First) + or else Lo < Uint_1 or else Hi > UI_From_Int (Int'Last) then return False; end if; - -- Comparison value was within 32-bits, so now we must check the - -- index value to make sure it is also within 32-bits. + -- Comparison value was within range, so now we must check the index + -- value to make sure it is also within 32-bits. Indx := First_Index (Etype (Ent)); diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 0dfbac1079c..dff0044f935 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -233,6 +233,7 @@ package body Exp_Intr is if not Is_Ancestor (Etype (Result_Typ), Etype (Tag_Arg), Use_Full_View => True) + and then Tagged_Type_Expansion then -- Obtain the reference to the Ada.Tags service before generating -- the Object_Declaration node to ensure that if this service is diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 371afbb9103..c176179058c 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -279,14 +279,15 @@ package Sem_Util is procedure Mark_Non_ALFA_Subprogram; -- If Current_Subprogram is not Empty, mark either its specification or its - -- body as not being in ALFA. If this procedure is called during the - -- analysis of a precondition or postcondition, as indicated by the flag - -- In_Pre_Post_Expression, mark the specification as not being in ALFA. - -- Otherwise, mark the body as not being in ALFA. - -- - -- I would really like to see more comments on this peculiar processing - -- for precondition/postcondition, the comment above says what is done - -- but not why??? + -- body as not being in ALFA. This procedure may be called either during + -- the analysis of a precondition or postcondition, as indicated by the + -- flag In_Pre_Post_Expression, or during the analysis of a subprogram's + -- body. In the first case, the specification of Current_Subprogram must be + -- marked as not being in ALFA, as the contract is considered to be part of + -- the specification, so that calls to this subprogram are not in ALFA. In + -- the second case, mark the body as not being in ALFA, which does not + -- prevent the subprogram's specification, and calls to the subprogram, to + -- be in ALFA. function Defining_Entity (N : Node_Id) return Entity_Id; -- Given a declaration N, returns the associated defining entity. If the -- 2.30.2