+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
-- --
-- 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- --
"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;
-- --
-- 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- --
begin
if Target.Is_Empty then
- Target.Assign (Source);
+ Move (Target => Target, Source => Source);
return;
end if;
-- --
-- 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- --
-- 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
-- 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);
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
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
-- 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,
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));
-- --
-- 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- --
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
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
projects / gcc.git / commitdiff