mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 23:31:21 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2013-01-03  Thomas Quinot  <quinot@adacore.com>

	* sem_ch7.adb, sem_ch10.adb, einfo.adb, einfo.ads, sem_ch12.adb,
	rtsfind.adb, sem_elab.adb, sem_ch4.adb, sem_ch8.adb
	(Einfo.Is_Visible_Child_Unit, Einfo.Set_Is_Visible_Child_Unit):
	Rename to Is_Visible_Lib_Unit, Set_Is_Visible_Lib_Unit, and
	update spec accordingly (now also applies to root library units).
	(Sem_Ch10.Analyze_Subunit.Analyze_Subunit_Context): Toggle above flag
	on root library units, not only child units.
	(Sem_Ch10.Install[_Limited]_Withed_Unit): Same.
	(Sem_Ch10.Remove_Unit_From_Visibility): Reset Is_Visible_Lib_Unit
	even for root library units.
	(Sem_Ch8.Find_Expanded_Name): A selected component form whose prefix is
	Standard is an expanded name for a root library unit.

2013-01-03  Thomas Quinot  <quinot@adacore.com>

	* exp_ch3.adb: Minor reformatting.

2013-01-03  Olivier Hainque  <hainque@adacore.com>

	* tracebak.c: Reinstate changes to support ppc-lynx178.

2013-01-03  Ed Schonberg  <schonberg@adacore.com>

	* atree.ads: Minor reformatting and documentation enhancement.

From-SVN: r194845
This commit is contained in:
Arnaud Charlet 2013-01-03 11:52:31 +01:00
parent 0c6f926d31
commit 8ca1ee5da3
13 changed files with 123 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
gcc/ada/ChangeLog
View File

@ -1,3 +1,30 @@
2013-01-03 Thomas Quinot <quinot@adacore.com>
* sem_ch7.adb, sem_ch10.adb, einfo.adb, einfo.ads, sem_ch12.adb,
rtsfind.adb, sem_elab.adb, sem_ch4.adb, sem_ch8.adb
(Einfo.Is_Visible_Child_Unit, Einfo.Set_Is_Visible_Child_Unit):
Rename to Is_Visible_Lib_Unit, Set_Is_Visible_Lib_Unit, and
update spec accordingly (now also applies to root library units).
(Sem_Ch10.Analyze_Subunit.Analyze_Subunit_Context): Toggle above flag
on root library units, not only child units.
(Sem_Ch10.Install[_Limited]_Withed_Unit): Same.
(Sem_Ch10.Remove_Unit_From_Visibility): Reset Is_Visible_Lib_Unit
even for root library units.
(Sem_Ch8.Find_Expanded_Name): A selected component form whose prefix is
Standard is an expanded name for a root library unit.
2013-01-03 Thomas Quinot <quinot@adacore.com>
* exp_ch3.adb: Minor reformatting.
2013-01-03 Olivier Hainque <hainque@adacore.com>
* tracebak.c: Reinstate changes to support ppc-lynx178.
2013-01-03 Ed Schonberg <schonberg@adacore.com>
* atree.ads: Minor reformatting and documentation enhancement.
2013-01-03 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.adb (Expand_N_Object_Declaration): If the object has

4
gcc/ada/atree.ads
View File

@ -508,7 +508,9 @@ package Atree is
-- entities point correctly to their original parents. The effect is thus
-- to leave the tree completely unchanged in structure, except that the
-- entity ID values of the two entities are interchanged. Neither of the
-- two entities may be list members.
-- two entities may be list members. Note that entities appear on two
-- semantic chains: Homonym and Next_Entity: the corresponding links must
-- be adjusted by the caller, according to context.
function Extend_Node (Node : Node_Id) return Entity_Id;
-- This function returns a copy of its input node with an extension added.

14
gcc/ada/einfo.adb
View File

@ -375,7 +375,7 @@ package body Einfo is
-- No_Return Flag113
-- Delay_Cleanups Flag114
-- Never_Set_In_Source Flag115
-- Is_Visible_Child_Unit Flag116
-- Is_Visible_Lib_Unit Flag116
-- Is_Unchecked_Union Flag117
-- Is_For_Access_Subtype Flag118
-- Has_Convention_Pragma Flag119
@ -2175,11 +2175,10 @@ package body Einfo is
return Flag127 (Id);
end Is_Valued_Procedure;
function Is_Visible_Child_Unit (Id : E) return B is
function Is_Visible_Lib_Unit (Id : E) return B is
begin
pragma Assert (Is_Child_Unit (Id));
return Flag116 (Id);
end Is_Visible_Child_Unit;
end Is_Visible_Lib_Unit;
function Is_Visible_Formal (Id : E) return B is
begin
@ -4736,11 +4735,10 @@ package body Einfo is
Set_Flag127 (Id, V);
end Set_Is_Valued_Procedure;
procedure Set_Is_Visible_Child_Unit (Id : E; V : B := True) is
procedure Set_Is_Visible_Lib_Unit (Id : E; V : B := True) is
begin
pragma Assert (Is_Child_Unit (Id));
Set_Flag116 (Id, V);
end Set_Is_Visible_Child_Unit;
end Set_Is_Visible_Lib_Unit;
procedure Set_Is_Visible_Formal (Id : E; V : B := True) is
begin
@ -7602,7 +7600,7 @@ package body Einfo is
W ("Is_Unsigned_Type", Flag144 (Id));
W ("Is_VMS_Exception", Flag133 (Id));
W ("Is_Valued_Procedure", Flag127 (Id));
W ("Is_Visible_Child_Unit", Flag116 (Id));
W ("Is_Visible_Lib_Unit", Flag116 (Id));
W ("Is_Visible_Formal", Flag206 (Id));
W ("Is_Volatile", Flag16 (Id));
W ("Itype_Printed", Flag202 (Id));

24
gcc/ada/einfo.ads
View File

@ -2856,11 +2856,11 @@ package Einfo is
-- Defined in procedure entities. Set if an Import_Valued_Procedure
-- or Export_Valued_Procedure pragma applies to the procedure entity.
-- Is_Visible_Child_Unit (Flag116)
-- Defined in compilation units that are child units. Once compiled,
-- child units remain chained to the entities in the parent unit, and
-- a separate flag must be used to indicate whether the names are
-- visible by selected notation, or not.
-- Is_Visible_Lib_Unit (Flag116)
-- Defined in all (root or child) library unit entities. Once compiled,
-- library units remain chained to the entities in the parent scope, and
-- a separate flag must be used to indicate whether the names are visible
-- by selected notation, or not.
-- Is_Visible_Formal (Flag206)
-- Defined in all entities. Set True for instances of the formals of a
@ -5310,7 +5310,7 @@ package Einfo is
-- Is_Private_Primitive (Flag245) (non-generic case only)
-- Is_Pure (Flag44)
-- Is_Thunk (Flag225)
-- Is_Visible_Child_Unit (Flag116)
-- Is_Visible_Lib_Unit (Flag116)
-- Needs_No_Actuals (Flag22)
-- Requires_Overriding (Flag213) (non-generic case only)
-- Return_Present (Flag54)
@ -5490,7 +5490,7 @@ package Einfo is
-- In_Use (Flag8)
-- Is_Instantiated (Flag126)
-- Is_Private_Descendant (Flag53)
-- Is_Visible_Child_Unit (Flag116)
-- Is_Visible_Lib_Unit (Flag116)
-- Renamed_In_Spec (Flag231) (non-generic case only)
-- Static_Elaboration_Desired (Flag77) (non-generic case only)
-- Is_Wrapper_Package (synth) (non-generic case only)
@ -5580,7 +5580,7 @@ package Einfo is
-- Is_Pure (Flag44)
-- Is_Thunk (Flag225)
-- Is_Valued_Procedure (Flag127)
-- Is_Visible_Child_Unit (Flag116)
-- Is_Visible_Lib_Unit (Flag116)
-- Needs_No_Actuals (Flag22)
-- No_Return (Flag113)
-- Requires_Overriding (Flag213) (non-generic case only)
@ -6310,7 +6310,7 @@ package Einfo is
function Is_Unsigned_Type (Id : E) return B;
function Is_VMS_Exception (Id : E) return B;
function Is_Valued_Procedure (Id : E) return B;
function Is_Visible_Child_Unit (Id : E) return B;
function Is_Visible_Lib_Unit (Id : E) return B;
function Is_Visible_Formal (Id : E) return B;
function Is_Volatile (Id : E) return B;
function Itype_Printed (Id : E) return B;
@ -6908,7 +6908,7 @@ package Einfo is
procedure Set_Is_Unsigned_Type (Id : E; V : B := True);
procedure Set_Is_VMS_Exception (Id : E; V : B := True);
procedure Set_Is_Valued_Procedure (Id : E; V : B := True);
procedure Set_Is_Visible_Child_Unit (Id : E; V : B := True);
procedure Set_Is_Visible_Lib_Unit (Id : E; V : B := True);
procedure Set_Is_Visible_Formal (Id : E; V : B := True);
procedure Set_Is_Volatile (Id : E; V : B := True);
procedure Set_Itype_Printed (Id : E; V : B := True);
@ -7629,7 +7629,7 @@ package Einfo is
pragma Inline (Is_Unsigned_Type);
pragma Inline (Is_VMS_Exception);
pragma Inline (Is_Valued_Procedure);
pragma Inline (Is_Visible_Child_Unit);
pragma Inline (Is_Visible_Lib_Unit);
pragma Inline (Is_Visible_Formal);
pragma Inline (Itype_Printed);
pragma Inline (Kill_Elaboration_Checks);
@ -8035,7 +8035,7 @@ package Einfo is
pragma Inline (Set_Is_Unsigned_Type);
pragma Inline (Set_Is_VMS_Exception);
pragma Inline (Set_Is_Valued_Procedure);
pragma Inline (Set_Is_Visible_Child_Unit);
pragma Inline (Set_Is_Visible_Lib_Unit);
pragma Inline (Set_Is_Visible_Formal);
pragma Inline (Set_Is_Volatile);
pragma Inline (Set_Itype_Printed);

19
gcc/ada/exp_ch3.adb
View File

@ -5315,6 +5315,17 @@ package body Exp_Ch3 is
Subtype_Mark => New_Occurrence_Of (Typ, Loc),
Name => Convert_Tag_To_Interface (Typ, Tag_Comp)));
-- If the original entity comes from source, then mark the
-- new entity as needing debug information, even though it's
-- defined by a generated renaming that does not come from
-- source, so that Materialize_Entity will be set on the
-- entity when Debug_Renaming_Declaration is called during
-- analysis.
if Comes_From_Source (Def_Id) then
Set_Debug_Info_Needed (Defining_Identifier (N));
end if;
Analyze (N, Suppress => All_Checks);
-- Replace internal identifier of rewritten node by the
@ -5328,7 +5339,7 @@ package body Exp_Ch3 is
-- which may be a constant. Preserve entity chain because
-- itypes may have been generated already, and the full
-- chain must be preserved for final freezing. Finally,
-- Preserve Comes_From_Source setting, so that debugging
-- preserve Comes_From_Source setting, so that debugging
-- and cross-referencing information is properly kept.
declare
@ -5340,9 +5351,11 @@ package body Exp_Ch3 is
begin
Set_Next_Entity (New_Id, Next_Entity (Def_Id));
Set_Next_Entity (Def_Id, Next_Temp);
Set_Chars (Defining_Identifier (N), Chars (Def_Id));
Set_Chars (Defining_Identifier (N), Chars (Def_Id));
Set_Homonym (Defining_Identifier (N), Homonym (Def_Id));
Set_Ekind (Defining_Identifier (N), Ekind (Def_Id));
Set_Ekind (Defining_Identifier (N), Ekind (Def_Id));
Set_Comes_From_Source (Def_Id, False);
Exchange_Entities (Defining_Identifier (N), Def_Id);
Set_Comes_From_Source (Def_Id, S_Flag);

2
gcc/ada/rtsfind.adb
View File

@ -1466,7 +1466,7 @@ package body Rtsfind is
end if;
Load_RTU (To_Load, Use_Setting => In_Use (Cunit_Entity (U)));
Set_Is_Visible_Child_Unit (RT_Unit_Table (To_Load).Entity);
Set_Is_Visible_Lib_Unit (RT_Unit_Table (To_Load).Entity);
-- Prevent creation of an implicit 'with' from (for example)
-- Ada.Wide_Text_IO.Integer_IO to Ada.Text_IO.Integer_IO,

47
gcc/ada/sem_ch10.adb
View File

@ -2040,9 +2040,15 @@ package body Sem_Ch10 is
end if;
Unit_Name := Entity (Name (Item));
while Is_Child_Unit (Unit_Name) loop
Set_Is_Visible_Child_Unit (Unit_Name);
loop
Set_Is_Visible_Lib_Unit (Unit_Name);
exit when Scope (Unit_Name) = Standard_Standard;
Unit_Name := Scope (Unit_Name);
if No (Unit_Name) then
Check_Error_Detected;
return;
end if;
end loop;
if not Is_Immediately_Visible (Unit_Name) then
@ -2083,8 +2089,9 @@ package body Sem_Ch10 is
and then not Error_Posted (Item)
then
Unit_Name := Entity (Name (Item));
while Is_Child_Unit (Unit_Name) loop
Set_Is_Visible_Child_Unit (Unit_Name, False);
loop
Set_Is_Visible_Lib_Unit (Unit_Name, False);
exit when Scope (Unit_Name) = Standard_Standard;
Unit_Name := Scope (Unit_Name);
end loop;
@ -2131,7 +2138,7 @@ package body Sem_Ch10 is
E := First_Entity (Current_Scope);
while Present (E) loop
if not Is_Child_Unit (E)
or else Is_Visible_Child_Unit (E)
or else Is_Visible_Lib_Unit (E)
then
Set_Is_Immediately_Visible (E);
end if;
@ -2296,11 +2303,9 @@ package body Sem_Ch10 is
C : Entity_Id;
begin
C := Current_Scope;
while Present (C)
and then Is_Child_Unit (C)
loop
while Present (C) and then C /= Standard_Standard loop
Set_Is_Immediately_Visible (C);
Set_Is_Visible_Child_Unit (C);
Set_Is_Visible_Lib_Unit (C);
C := Scope (C);
end loop;
end;
@ -4210,7 +4215,7 @@ package body Sem_Ch10 is
end In_Context;
begin
Set_Is_Visible_Child_Unit (Id, In_Context);
Set_Is_Visible_Lib_Unit (Id, In_Context);
end;
end if;
end if;
@ -4788,7 +4793,7 @@ package body Sem_Ch10 is
if Analyzed (P_Unit)
and then
(Is_Immediately_Visible (P)
or else (Is_Child_Package and then Is_Visible_Child_Unit (P)))
or else (Is_Child_Package and then Is_Visible_Lib_Unit (P)))
then
-- The presence of both the limited and the analyzed nonlimited view
@ -4852,10 +4857,10 @@ package body Sem_Ch10 is
Set_Ekind (P, E_Package);
Set_Etype (P, Standard_Void_Type);
Set_Scope (P, Standard_Standard);
Set_Is_Visible_Lib_Unit (P);
if Is_Child_Package then
Set_Is_Child_Unit (P);
Set_Is_Visible_Child_Unit (P);
Set_Scope (P, Defining_Entity (Unit (Parent_Spec (P_Unit))));
end if;
@ -5101,7 +5106,7 @@ package body Sem_Ch10 is
Error_Msg_N
("instantiation depends on itself", Name (With_Clause));
elsif not Is_Visible_Child_Unit (Uname) then
elsif not Is_Visible_Lib_Unit (Uname) then
-- Abandon processing in case of previous errors
@ -5110,7 +5115,7 @@ package body Sem_Ch10 is
return;
end if;
Set_Is_Visible_Child_Unit (Uname);
Set_Is_Visible_Lib_Unit (Uname);
-- If the child unit appears in the context of its parent, it is
-- immediately visible.
@ -5125,7 +5130,7 @@ package body Sem_Ch10 is
-- Set flag as well on the visible entity that denotes the
-- instance, which renames the current one.
Set_Is_Visible_Child_Unit
Set_Is_Visible_Lib_Unit
(Related_Instance
(Defining_Entity (Unit (Library_Unit (With_Clause)))));
end if;
@ -5141,6 +5146,7 @@ package body Sem_Ch10 is
end if;
elsif not Is_Immediately_Visible (Uname) then
Set_Is_Visible_Lib_Unit (Uname);
if not Private_Present (With_Clause)
or else Private_With_OK
then
@ -5167,7 +5173,7 @@ package body Sem_Ch10 is
-- not apply the check to the Standard package itself.
if Is_Child_Unit (Uname)
and then Is_Visible_Child_Unit (Uname)
and then Is_Visible_Lib_Unit (Uname)
and then Ada_Version >= Ada_2005
then
declare
@ -5185,7 +5191,7 @@ package body Sem_Ch10 is
Decl2 := Unit_Declaration_Node (P2);
if Is_Child_Unit (U2)
and then Is_Visible_Child_Unit (U2)
and then Is_Visible_Lib_Unit (U2)
then
if Is_Generic_Instance (P)
and then Nkind (Decl1) = N_Package_Declaration
@ -6220,8 +6226,6 @@ package body Sem_Ch10 is
---------------------------------
procedure Remove_Unit_From_Visibility (Unit_Name : Entity_Id) is
P : constant Entity_Id := Scope (Unit_Name);
begin
if Debug_Flag_I then
Write_Str ("remove unit ");
@ -6230,10 +6234,7 @@ package body Sem_Ch10 is
Write_Eol;
end if;
if P /= Standard_Standard then
Set_Is_Visible_Child_Unit (Unit_Name, False);
end if;
Set_Is_Visible_Lib_Unit (Unit_Name, False);
Set_Is_Potentially_Use_Visible (Unit_Name, False);
Set_Is_Immediately_Visible (Unit_Name, False);

2
gcc/ada/sem_ch12.adb
View File

@ -5719,7 +5719,7 @@ package body Sem_Ch12 is
and then Is_Child_Unit (E)
then
if Is_Child_Unit (E)
and then not Is_Visible_Child_Unit (E)
and then not Is_Visible_Lib_Unit (E)
then
Error_Msg_NE
("generic child unit& is not visible", Gen_Id, E);

4
gcc/ada/sem_ch4.adb
View File

@ -1765,7 +1765,7 @@ package body Sem_Ch4 is
(Is_Immediately_Visible (Scope (DT))
or else
(Is_Child_Unit (Scope (DT))
and then Is_Visible_Child_Unit (Scope (DT))))
and then Is_Visible_Lib_Unit (Scope (DT))))
then
Set_Etype (N, Available_View (DT));
@ -6320,7 +6320,7 @@ package body Sem_Ch4 is
(Is_Immediately_Visible (Scope (Typ))
or else
(Is_Child_Unit (Scope (Typ))
and then Is_Visible_Child_Unit (Scope (Typ))))
and then Is_Visible_Lib_Unit (Scope (Typ))))
then
return Available_View (Typ);
else

2
gcc/ada/sem_ch7.adb
View File

@ -2253,7 +2253,7 @@ package body Sem_Ch7 is
if Is_Child_Unit (Id) then
Set_Is_Potentially_Use_Visible
(Id, Is_Visible_Child_Unit (Id));
(Id, Is_Visible_Lib_Unit (Id));
else
Set_Is_Potentially_Use_Visible (Id);
end if;

14
gcc/ada/sem_ch8.adb
View File

@ -5143,8 +5143,8 @@ package body Sem_Ch8 is
end if;
if Is_New_Candidate then
if Is_Child_Unit (Id) then
exit when Is_Visible_Child_Unit (Id)
if Is_Child_Unit (Id) or else P_Name = Standard_Standard then
exit when Is_Visible_Lib_Unit (Id)
or else Is_Immediately_Visible (Id);
else
@ -5334,7 +5334,7 @@ package body Sem_Ch8 is
and then Is_Compilation_Unit (Homonym (P_Name))
and then
(Is_Immediately_Visible (Homonym (P_Name))
or else Is_Visible_Child_Unit (Homonym (P_Name)))
or else Is_Visible_Lib_Unit (Homonym (P_Name)))
then
declare
H : constant Entity_Id := Homonym (P_Name);
@ -7685,7 +7685,7 @@ package body Sem_Ch8 is
if Is_Child_Unit (E) then
if not From_With_Type (E) then
Set_Is_Immediately_Visible (E,
Is_Visible_Child_Unit (E) or else In_Open_Scopes (E));
Is_Visible_Lib_Unit (E) or else In_Open_Scopes (E));
else
pragma Assert
@ -7718,7 +7718,7 @@ package body Sem_Ch8 is
while Present (E) loop
if Is_Child_Unit (E) then
Set_Is_Immediately_Visible (E,
Is_Visible_Child_Unit (E) or else In_Open_Scopes (E));
Is_Visible_Lib_Unit (E) or else In_Open_Scopes (E));
end if;
Next_Entity (E);
@ -8030,7 +8030,7 @@ package body Sem_Ch8 is
if not Is_Hidden (Id)
and then ((not Is_Child_Unit (Id))
or else Is_Visible_Child_Unit (Id))
or else Is_Visible_Lib_Unit (Id))
then
Set_Is_Potentially_Use_Visible (Id);
@ -8050,7 +8050,7 @@ package body Sem_Ch8 is
while Present (Id) loop
if Is_Child_Unit (Id)
and then Is_Visible_Child_Unit (Id)
and then Is_Visible_Lib_Unit (Id)
then
Set_Is_Potentially_Use_Visible (Id);
end if;

2
gcc/ada/sem_elab.adb
View File

@ -2551,7 +2551,7 @@ package body Sem_Elab is
-- visible, and we can set the elaboration flag.
if Is_Immediately_Visible (Scop)
or else (Is_Child_Unit (Scop) and then Is_Visible_Child_Unit (Scop))
or else (Is_Child_Unit (Scop) and then Is_Visible_Lib_Unit (Scop))
then
Activate_Elaborate_All_Desirable (Call, Scop);
Set_Suppress_Elaboration_Warnings (Scop, True);

25
gcc/ada/tracebak.c
View File

@ -35,6 +35,7 @@
PowerPC/AiX
PowerPC/Darwin
PowerPC/VxWorks
PowerPC/LynxOS-178
SPARC/Solaris
i386/GNU/Linux
i386/Solaris
@ -287,9 +288,10 @@ __gnat_backtrace (void **array,
#error Unhandled darwin architecture.
#endif
/*------------------------ PPC AIX/Older Darwin -------------------------*/
/*---------------------- PPC AIX/PPC Lynx 178/Older Darwin ------------------*/
#elif ((defined (_POWER) && defined (_AIX)) || \
(defined (__ppc__) && defined (__APPLE__)))
(defined (__powerpc__) && defined (__Lynx__) && !defined(__ELF__)) || \
(defined (__ppc__) && defined (__APPLE__)))
#define USE_GENERIC_UNWINDER
@ -307,9 +309,26 @@ struct layout
should to feature a null backchain, AIX might expose a null return
address instead. */
/* Then LynxOS-178 features yet another variation, with return_address
== &<entrypoint>, with two possible entry points (one for the main
process and one for threads). Beware that &bla returns the address
of a descriptor when "bla" is a function. Getting the code address
requires an extra dereference. */
#if defined (__Lynx__)
extern void __start(); /* process entry point. */
extern void __runnit(); /* thread entry point. */
#define EXTRA_STOP_CONDITION(CURRENT) \
((CURRENT)->return_address == *(void**)&__start \
|| (CURRENT)->return_address == *(void**)&__runnit)
#else
#define EXTRA_STOP_CONDITION(CURRENT) (0)
#endif
#define STOP_FRAME(CURRENT, TOP_STACK) \
(((void *) (CURRENT) < (TOP_STACK)) \
|| (CURRENT)->return_address == NULL)
|| (CURRENT)->return_address == NULL \
|| EXTRA_STOP_CONDITION(CURRENT))
/* The PPC ABI has an interesting specificity: the return address saved by a
function is located in it's caller's frame, and the save operation only