OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2010-10-05  Robert Dewar  <dewar@adacore.com>

	* sem_ch4.adb: Minor reformatting.
	* a-direct.ads: Minor comment update.

2010-10-05  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Add_Internal_Interface_Entities): Removing code that is
	no longer required after change in New_Overloaded_Entity.
	* sem_ch6.adb (New_Overloaded_Entity): Code reorganization to isolate
	the fragment of code that handles derivations of interface primitives.
	Add missing dependence on global variable Inside_Freezing_Actions to
	ensure the correct management of internal interface entities.
	* sem_ch13.adb (Analyze_Freeze_Entity): Add missing increase/decrease
	of the global variable Inside_Freezing_Actions to ensure that internal
	interface entities are well handled by New_Overloaded_Entity.
	* sem_disp.adb (Find_Primitive_Covering_Interface): Add documentation
	and complete the algorithm to catch hidden primitives derived of
	private type that covers the interface.
	* sem_disp.ads (Find_Primitive_Covering_Interface): Add missing
	documentation.

From-SVN: r164982
This commit is contained in:
Arnaud Charlet 2010-10-05 12:26:07 +02:00
parent 22b77f6852
commit 947430d5fe
8 changed files with 127 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gcc/ada/ChangeLog
View File

@ -1,3 +1,25 @@
2010-10-05 Robert Dewar <dewar@adacore.com>
* sem_ch4.adb: Minor reformatting.
* a-direct.ads: Minor comment update.
2010-10-05 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Add_Internal_Interface_Entities): Removing code that is
no longer required after change in New_Overloaded_Entity.
* sem_ch6.adb (New_Overloaded_Entity): Code reorganization to isolate
the fragment of code that handles derivations of interface primitives.
Add missing dependence on global variable Inside_Freezing_Actions to
ensure the correct management of internal interface entities.
* sem_ch13.adb (Analyze_Freeze_Entity): Add missing increase/decrease
of the global variable Inside_Freezing_Actions to ensure that internal
interface entities are well handled by New_Overloaded_Entity.
* sem_disp.adb (Find_Primitive_Covering_Interface): Add documentation
and complete the algorithm to catch hidden primitives derived of
private type that covers the interface.
* sem_disp.ads (Find_Primitive_Covering_Interface): Add missing
documentation.
2010-10-05 Robert Dewar <dewar@adacore.com>
* prj-util.adb, prj-util.ads, prj.ads, s-vxwext-rtp.adb, sem_ch4.adb,

12
gcc/ada/a-direct.ads
View File

@ -200,14 +200,14 @@ package Ada.Directories is
-- timestamps: Preserve the timestamp of the copied file, but not
-- the other file attributes.
--
--
-- The allowed values for mode= are:
--
-- copy: Only copy if the destination file does not already
-- exist. If it already exists, Copy_File will fail.
--
-- overwrite: Copy the file in all cases. Overwite an already
-- existing destination file.
-- existing destination file. This is the default if
-- no mode= is found in Form.
--
-- append: Append the original file to the destination file.
-- If the destination file does not exist, the
@ -215,19 +215,17 @@ package Ada.Directories is
-- When mode=append, the field preserve=, if it
-- exists, is not taken into account.
--
-- What is the default value for mode=???
--
-- If the Form parameter includes one or both of the fields and the value
-- or values are incorrect, Copy_file fails with Use_Error.
-- or values are incorrect, Copy_File fails with Use_Error.
--
-- Examples of correct Forms:
-- Form => "preserve=no_attributes,mode=overwrite" (the default)
-- Form => "mode=append"
-- Form => "mode=copy, preserve=all_attributes"
-- Form => "mode=copy,preserve=all_attributes"
--
-- Examples of incorrect Forms:
-- Form => "preserve=junk"
-- Form => "mode=internal, preserve=timestamps"
-- Form => "mode=internal,preserve=timestamps"
----------------------------------------
-- File and directory name operations --

9
gcc/ada/sem_ch13.adb
View File

@ -2396,9 +2396,14 @@ package body Sem_Ch13 is
E : constant Entity_Id := Entity (N);
begin
-- Remember that we are processing a freezing entity. Required to
-- ensure correct decoration of internal entities associated with
-- interfaces (see New_Overloaded_Entity).
Inside_Freezing_Actions := Inside_Freezing_Actions + 1;
-- For tagged types covering interfaces add internal entities that link
-- the primitives of the interfaces with the primitives that cover them.
-- Note: These entities were originally generated only when generating
-- code because their main purpose was to provide support to initialize
-- the secondary dispatch tables. They are now generated also when
@ -2485,6 +2490,8 @@ package body Sem_Ch13 is
end loop;
end;
end if;
Inside_Freezing_Actions := Inside_Freezing_Actions - 1;
end Analyze_Freeze_Entity;
------------------------------------------

18
gcc/ada/sem_ch3.adb
View File

@ -1550,22 +1550,7 @@ package body Sem_Ch3 is
(Tagged_Type => Tagged_Type,
Iface_Prim => Iface_Prim);
-- Handle cases where the type has no primitive covering this
-- interface primitive.
if No (Prim) then
-- Skip non-overridden null interface primitives because
-- their wrappers will be generated later.
if Is_Null_Interface_Primitive (Iface_Prim) then
goto Continue;
else
pragma Assert (False);
raise Program_Error;
end if;
end if;
pragma Assert (Present (Prim));
Derive_Subprogram
(New_Subp => New_Subp,
@ -1605,7 +1590,6 @@ package body Sem_Ch3 is
Set_Has_Delayed_Freeze (New_Subp);
end if;
<<Continue>>
Next_Elmt (Elmt);
end loop;

16
gcc/ada/sem_ch4.adb
View File

@ -891,8 +891,8 @@ package body Sem_Ch4 is
-- If this is an indirect call, the return type of the access_to
-- subprogram may be an incomplete type. At the point of the call,
-- use the full type if available, and at the same time update
-- the return type of the access_to_subprogram.
-- use the full type if available, and at the same time update the
-- return type of the access_to_subprogram.
if Success
and then Nkind (Nam) = N_Explicit_Dereference
@ -920,12 +920,12 @@ package body Sem_Ch4 is
-- Name may be call that returns an access to subprogram, or more
-- generally an overloaded expression one of whose interpretations
-- yields an access to subprogram. If the name is an entity, we
-- do not dereference, because the node is a call that returns
-- the access type: note difference between f(x), where the call
-- may return an access subprogram type, and f(x)(y), where the
-- type returned by the call to f is implicitly dereferenced to
-- analyze the outer call.
-- yields an access to subprogram. If the name is an entity, we do
-- not dereference, because the node is a call that returns the
-- access type: note difference between f(x), where the call may
-- return an access subprogram type, and f(x)(y), where the type
-- returned by the call to f is implicitly dereferenced to analyze
-- the outer call.
if Is_Access_Type (Nam_Ent) then
Nam_Ent := Designated_Type (Nam_Ent);

74
gcc/ada/sem_ch6.adb
View File

@ -7542,6 +7542,53 @@ package body Sem_Ch6 is
E := Current_Entity_In_Scope (S);
-- Ada 2005 (AI-251): Derivation of abstract interface primitives.
-- They are directly added to the list of primitive operations of
-- Derived_Type, unless this is a rederivation in the private part
-- of an operation that was already derived in the visible part of
-- the current package.
if Ada_Version >= Ada_05
and then Present (Derived_Type)
and then Present (Alias (S))
and then Is_Dispatching_Operation (Alias (S))
and then Present (Find_Dispatching_Type (Alias (S)))
and then Is_Interface (Find_Dispatching_Type (Alias (S)))
then
-- For private types, when the full-view is processed we propagate to
-- the full view the non-overridden entities whose attribute "alias"
-- references an interface primitive. These entities were added by
-- Derive_Subprograms to ensure that interface primitives are
-- covered.
-- Inside_Freeze_Actions is non zero when S corresponds with an
-- internal entity that links an interface primitive with its
-- covering primitive through attribute Interface_Alias (see
-- Add_Internal_Interface_Entities)
if Inside_Freezing_Actions = 0
and then Is_Package_Or_Generic_Package (Current_Scope)
and then In_Private_Part (Current_Scope)
and then Nkind (Parent (E)) = N_Private_Extension_Declaration
and then Nkind (Parent (S)) = N_Full_Type_Declaration
and then Full_View (Defining_Identifier (Parent (E)))
= Defining_Identifier (Parent (S))
and then Alias (E) = Alias (S)
then
Check_Operation_From_Private_View (S, E);
Set_Is_Dispatching_Operation (S);
-- Common case
else
Enter_Overloaded_Entity (S);
Check_Dispatching_Operation (S, Empty);
Check_For_Primitive_Subprogram (Is_Primitive_Subp);
end if;
return;
end if;
-- If there is no homonym then this is definitely not overriding
if No (E) then
@ -7617,31 +7664,6 @@ package body Sem_Ch6 is
-- E exists and is overloadable
else
-- Ada 2005 (AI-251): Derivation of abstract interface primitives.
-- They are directly added to the list of primitive operations of
-- Derived_Type, unless this is a rederivation in the private part
-- of an operation that was already derived in the visible part of
-- the current package.
if Ada_Version >= Ada_05
and then Present (Derived_Type)
and then Present (Alias (S))
and then Is_Dispatching_Operation (Alias (S))
and then Present (Find_Dispatching_Type (Alias (S)))
and then Is_Interface (Find_Dispatching_Type (Alias (S)))
then
if Type_Conformant (E, S)
and then Is_Package_Or_Generic_Package (Current_Scope)
and then In_Private_Part (Current_Scope)
and then Parent (E) /= Parent (S)
and then Alias (E) = Alias (S)
then
Check_Operation_From_Private_View (S, E);
else
goto Add_New_Entity;
end if;
end if;
Check_Synchronized_Overriding (S, Overridden_Subp);
-- Loop through E and its homonyms to determine if any of them is
@ -7999,8 +8021,6 @@ package body Sem_Ch6 is
E := Homonym (E);
end loop;
<<Add_New_Entity>>
-- On exit, we know that S is a new entity
Enter_Overloaded_Entity (S);

37
gcc/ada/sem_disp.adb
View File

@ -1661,7 +1661,9 @@ package body Sem_Disp is
Is_Interface
(Find_Dispatching_Type (Ultimate_Alias (Iface_Prim)))));
-- Search in the homonym chain
-- Search in the homonym chain. Done to speed up locating visible
-- entities and required to catch primitives associated with the partial
-- view of private types when processing the corresponding full view.
E := Current_Entity (Iface_Prim);
while Present (E) loop
@ -1675,16 +1677,39 @@ package body Sem_Disp is
E := Homonym (E);
end loop;
-- Search in the list of primitives of the type
-- Search in the list of primitives of the type. Required to locate the
-- covering primitive if the covering primitive is not visible (for
-- example, non-visible inherited primitive of private type).
El := First_Elmt (Primitive_Operations (Tagged_Type));
while Present (El) loop
E := Node (El);
if No (Interface_Alias (E))
and then Alias (E) = Iface_Prim
then
return Node (El);
-- Keep separate the management of internal entities that link
-- primitives with interface primitives from tagged type primitives.
if No (Interface_Alias (E)) then
if Present (Alias (E)) then
-- This interface primitive has not been covered yet
if Alias (E) = Iface_Prim then
return E;
-- The covering primitive was inherited
elsif Overridden_Operation (Ultimate_Alias (E))
= Iface_Prim
then
return E;
end if;
end if;
-- Use the internal entity that links the interface primitive with
-- the covering primitive to locate the entity
elsif Interface_Alias (E) = Iface_Prim then
return Alias (E);
end if;
Next_Elmt (El);

6
gcc/ada/sem_disp.ads
View File

@ -87,7 +87,11 @@ package Sem_Disp is
-- associated with the partial view of private types when processing the
-- corresponding full view. If the entity is not found then search for it
-- in the list of primitives of Tagged_Type. This latter search is needed
-- when the interface primitive is covered by a private subprogram.
-- when the interface primitive is covered by a private subprogram. If the
-- primitive has not been covered yet then return the entity that will be
-- overriden when the primitive is covered (that is, return the entity
-- whose alias attribute references the interface primitive). If none of
-- these entities is found then return Empty.
function Is_Dynamically_Tagged (N : Node_Id) return Boolean;
-- Used to determine whether a call is dispatching, i.e. if is an