[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:
Arnaud Charlet 2011-08-03 09:45:36 +02:00
parent b474d6c3f1
commit abcd9db2c8
8 changed files with 92 additions and 35 deletions

View File

@ -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

View File

@ -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;

View File

@ -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;

View File

@ -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

View File

@ -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

View File

@ -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));

View File

@ -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

View File

@ -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