[multiple changes]

2015-05-12  Pierre-Marie de Rodat  <derodat@adacore.com>

	* exp_pakd.adb: Make clearer the comment in exp_pakd.adb about
	___XP suffixes.

2015-05-12  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, sem_util.adb, sem_ch6.adb: Minor reformatting.

2015-05-12  Robert Dewar  <dewar@adacore.com>

	* exp_unst.adb (Visit_Node): Deal with subprogram and package stubs.

2015-05-12  Ed Schonberg  <schonberg@adacore.com>

	* exp_intr.adb (Expand_Dispatching_Constructor_Call): The
	tag to be retrieved for the generated call is the first entry
	in the dispatch table for the return type of the instantiated
	constructor.

2015-05-12  Bob Duff  <duff@adacore.com>

	* exp_ch7.adb, exp_ch7.ads, exp_intr.adb, exp_util.adb,
	exp_util.ads: Update comments.

From-SVN: r223050
This commit is contained in:
Arnaud Charlet 2015-05-12 11:17:45 +02:00
parent 0d780006d4
commit 7c4d86c9cc
11 changed files with 58 additions and 28 deletions

View File

@ -1,3 +1,28 @@
2015-05-12 Pierre-Marie de Rodat <derodat@adacore.com>
* exp_pakd.adb: Make clearer the comment in exp_pakd.adb about
___XP suffixes.
2015-05-12 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_util.adb, sem_ch6.adb: Minor reformatting.
2015-05-12 Robert Dewar <dewar@adacore.com>
* exp_unst.adb (Visit_Node): Deal with subprogram and package stubs.
2015-05-12 Ed Schonberg <schonberg@adacore.com>
* exp_intr.adb (Expand_Dispatching_Constructor_Call): The
tag to be retrieved for the generated call is the first entry
in the dispatch table for the return type of the instantiated
constructor.
2015-05-12 Bob Duff <duff@adacore.com>
* exp_ch7.adb, exp_ch7.ads, exp_intr.adb, exp_util.adb,
exp_util.ads: Update comments.
2015-05-12 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Add_Internal_Interface_Entities): Do no generate

View File

@ -6999,7 +6999,7 @@ package body Exp_Ch7 is
-- end if;
-- ...
-- When Deep_Finalize is invokes for field _parent, a value of False
-- When Deep_Finalize is invoked for field _parent, a value of False
-- is provided for the flag:
-- Deep_Finalize (Obj._parent, False);

View File

@ -221,14 +221,13 @@ package Exp_Ch7 is
(Typ : Entity_Id;
Nam : Entity_Id) return Node_Id;
-- Create a special version of Deep_Finalize with identifier Nam. The
-- routine has state information and can parform partial finalization.
-- routine has state information and can perform partial finalization.
function Make_Set_Finalize_Address_Call
(Loc : Source_Ptr;
Ptr_Typ : Entity_Id) return Node_Id;
-- Associate the Finalize_Address primitive of the designated type with the
-- finalization master of access type Ptr_Typ. The returned call is:
-- Generate the following call:
--
-- Set_Finalize_Address
-- (<Ptr_Typ>FM, <Desig_Typ>FD'Unrestricted_Access);
@ -265,7 +264,7 @@ package Exp_Ch7 is
-- Check whether composite type contains a simple protected component
function Is_Simple_Protected_Type (T : Entity_Id) return Boolean;
-- Determine whether T denotes a protected type without entires whose
-- Determine whether T denotes a protected type without entries whose
-- _object field is of type System.Tasking.Protected_Objects.Protection.
-- Something wrong here, implementation was changed to test Lock_Free
-- but this spec does not mention that ???

View File

@ -345,6 +345,9 @@ package body Exp_Intr is
begin
pragma Assert (not Is_Interface (Etype (Tag_Arg)));
-- The tag is the first entry in the dispatch table of the
-- return type of the constructor.
Iface_Tag :=
Make_Object_Declaration (Loc,
Defining_Identifier => Make_Temporary (Loc, 'V'),
@ -357,7 +360,7 @@ package body Exp_Intr is
Relocate_Node (Tag_Arg),
New_Occurrence_Of
(Node (First_Elmt (Access_Disp_Table
(Etype (Etype (Act_Constr))))),
(Etype (Act_Constr)))),
Loc))));
Insert_Action (N, Iface_Tag);
end;

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -764,7 +764,8 @@ package body Exp_Pakd is
elsif not Is_Constrained (Typ) then
-- When generating standard DWARF, the ___XP suffix will be stripped
-- When generating standard DWARF (i.e when GNAT_Encodings is
-- DWARF_GNAT_Encodings_Minimal), the ___XP suffix will be stripped
-- by the back-end but generate it anyway to ease compiler debugging.
-- This will help to distinguish implementation types from original
-- packed arrays.

View File

@ -730,6 +730,11 @@ package body Exp_Unst is
end if;
end if;
-- If we have a body stub, visit the associated subunit
elsif Nkind (N) in N_Body_Stub then
Visit (Library_Unit (N));
-- Skip generic declarations
elsif Nkind (N) in N_Generic_Declaration then

View File

@ -5067,7 +5067,7 @@ package body Exp_Util is
and then not Is_Allocated (Obj_Id)
-- If the transient object is a pointer, check that it is not
-- initialized by a function which returns a pointer or acts as a
-- initialized by a function that returns a pointer or acts as a
-- renaming of another pointer.
and then

View File

@ -635,7 +635,7 @@ package Exp_Util is
Rel_Node : Node_Id) return Boolean;
-- Determine whether declaration Decl denotes a controlled transient which
-- should be finalized. Rel_Node is the related context. Even though some
-- transient are controlled, they may act as renamings of other objects or
-- transients are controlled, they may act as renamings of other objects or
-- function calls.
function Is_Fully_Repped_Tagged_Type (T : Entity_Id) return Boolean;

View File

@ -1759,22 +1759,22 @@ package body Sem_Ch3 is
Set_Etype (New_Subp, Etype (Iface_Prim));
end if;
-- Internal entities associated with interface types are
-- only registered in the list of primitives of the tagged
-- type. They are only used to fill the contents of the
-- secondary dispatch tables. Therefore they are not needed
-- in the homonym chains.
-- Internal entities associated with interface types are only
-- registered in the list of primitives of the tagged type.
-- They are only used to fill the contents of the secondary
-- dispatch tables. Therefore they are not needed in the
-- homonym chains.
Remove_Homonym (New_Subp);
-- Hidden entities associated with interfaces must have set
-- the Has_Delay_Freeze attribute to ensure that, in case of
-- locally defined tagged types (or compiling with static
-- the Has_Delay_Freeze attribute to ensure that, in case
-- of locally defined tagged types (or compiling with static
-- dispatch tables generation disabled) the corresponding
-- entry of the secondary dispatch table is filled when
-- such an entity is frozen. This is an expansion activity
-- that must be suppressed for ASIS because it leads to
-- gigi elaboration issues in annotate mode.
-- entry of the secondary dispatch table is filled when such
-- an entity is frozen. This is an expansion activity that must
-- be suppressed for ASIS because it leads to gigi elaboration
-- issues in annotate mode.
if not ASIS_Mode then
Set_Has_Delayed_Freeze (New_Subp);
@ -2145,8 +2145,7 @@ package body Sem_Ch3 is
begin
Set_Etype (Id, Act_T);
-- Rewrite the component definition to use the constrained
-- subtype.
-- Rewrite component definition to use the constrained subtype
Rewrite (Component_Definition (N),
Make_Component_Definition (Loc,

View File

@ -3747,8 +3747,8 @@ package body Sem_Ch6 is
and then Full_Analysis
and then not Inside_A_Generic
and then Present (Spec_Id)
and then Nkind (Unit_Declaration_Node (Spec_Id)) =
N_Subprogram_Declaration
and then
Nkind (Unit_Declaration_Node (Spec_Id)) = N_Subprogram_Declaration
and then Can_Be_Inlined_In_GNATprove_Mode (Spec_Id, Body_Id)
and then not Body_Has_Contract
then
@ -3933,8 +3933,7 @@ package body Sem_Ch6 is
-- from precondition and postcondition pragmas).
if No (Last_Entity (Body_Id)) then
Set_First_Entity
(Body_Id, Next_Entity (Last_Real_Spec_Entity));
Set_First_Entity (Body_Id, Next_Entity (Last_Real_Spec_Entity));
-- Body entities present (formals), so chain stuff past them

View File

@ -10551,8 +10551,7 @@ package body Sem_Util is
Nam := Pragma_Name (Item);
end if;
return
Nam = Name_Abstract_State
return Nam = Name_Abstract_State
or else Nam = Name_Contract_Cases
or else Nam = Name_Depends
or else Nam = Name_Extensions_Visible