[multiple changes]
2011-08-03 Robert Dewar <dewar@adacore.com> * 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 <miranda@adacore.com> * 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 <heaney@adacore.com> * a-cobove.adb (Merge): Move source onto target, instead of using Assign 2011-08-03 Matthew Heaney <heaney@adacore.com> * a-cbdlli.adb (Splice): move source items from first to last 2011-08-03 Yannick Moy <moy@adacore.com> * sem_util.ads: comment added. 2011-08-03 Javier Miranda <miranda@adacore.com> * 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
This commit is contained in:
parent
b474d6c3f1
commit
abcd9db2c8
@ -1,3 +1,37 @@
|
||||
2011-08-03 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* 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 <miranda@adacore.com>
|
||||
|
||||
* 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 <heaney@adacore.com>
|
||||
|
||||
* a-cobove.adb (Merge): Move source onto target, instead of using Assign
|
||||
|
||||
2011-08-03 Matthew Heaney <heaney@adacore.com>
|
||||
|
||||
* a-cbdlli.adb (Splice): move source items from first to last
|
||||
|
||||
2011-08-03 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* sem_util.ads: comment added.
|
||||
|
||||
2011-08-03 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* 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 <schonberg@adacore.com>
|
||||
|
||||
* exp_ch9.adb (Build_Renamed_Formal_Declaration): common procedure for
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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));
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user