Commit e2cc5258 by Arnaud Charlet

[multiple changes]

2010-06-23  Olivier Hainque  <hainque@adacore.com>

	* einfo.adb (Has_Foreign_Convention): Consider Intrinsic with
	Interface_Name as foreign. These are GCC builtin imports for
	which Ada specific processing doesn't apply.

2010-06-23  Thomas Quinot  <quinot@adacore.com>

	* sem_ch12.adb: Minor reformatting.

2010-06-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Is_VMS_Operator): Use scope of system extension to
	determine whether an intrinsic subprogram is VMS specific.

2010-06-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* treepr.adb (Print_Entity_Info): Output the contents of Field28 if it
	is present in the entity.

From-SVN: r161262
parent 2503cb81
2010-06-23 Olivier Hainque <hainque@adacore.com>
* einfo.adb (Has_Foreign_Convention): Consider Intrinsic with
Interface_Name as foreign. These are GCC builtin imports for
which Ada specific processing doesn't apply.
2010-06-23 Thomas Quinot <quinot@adacore.com>
* sem_ch12.adb: Minor reformatting.
2010-06-23 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (Is_VMS_Operator): Use scope of system extension to
determine whether an intrinsic subprogram is VMS specific.
2010-06-23 Hristian Kirtchev <kirtchev@adacore.com>
* treepr.adb (Print_Entity_Info): Output the contents of Field28 if it
is present in the entity.
2010-06-23 Arnaud Charlet <charlet@adacore.com> 2010-06-23 Arnaud Charlet <charlet@adacore.com>
* xr_tabls.adb, xref_lib.adb: Update to latest lib-xref.ads * xr_tabls.adb, xref_lib.adb: Update to latest lib-xref.ads
......
...@@ -5850,7 +5850,13 @@ package body Einfo is ...@@ -5850,7 +5850,13 @@ package body Einfo is
function Has_Foreign_Convention (Id : E) return B is function Has_Foreign_Convention (Id : E) return B is
begin begin
return Convention (Id) in Foreign_Convention; -- While regular Intrinsics such as the Standard operators fit in the
-- "Ada" convention, those with an Interface_Name materialize GCC
-- builtin imports for which Ada special treatments shouldn't apply.
return Convention (Id) in Foreign_Convention
or else (Convention (Id) = Convention_Intrinsic
and then Present (Interface_Name (Id)));
end Has_Foreign_Convention; end Has_Foreign_Convention;
--------------------------- ---------------------------
......
...@@ -10864,8 +10864,8 @@ package body Sem_Ch12 is ...@@ -10864,8 +10864,8 @@ package body Sem_Ch12 is
Get_Body_Name (Get_Unit_Name (Unit (Comp_Unit))); Get_Body_Name (Get_Unit_Name (Unit (Comp_Unit)));
begin begin
-- In CodePeer mode, the missing body may make the -- In CodePeer mode, the missing body may make the analysis
-- analysis incomplete, but we do not treat it as fatal. -- incomplete, but we do not treat it as fatal.
if CodePeer_Mode then if CodePeer_Mode then
return; return;
...@@ -10873,8 +10873,8 @@ package body Sem_Ch12 is ...@@ -10873,8 +10873,8 @@ package body Sem_Ch12 is
else else
Error_Msg_Unit_1 := Bname; Error_Msg_Unit_1 := Bname;
Error_Msg_N ("this instantiation requires$!", N); Error_Msg_N ("this instantiation requires$!", N);
Error_Msg_File_1 Error_Msg_File_1 :=
:= Get_File_Name (Bname, Subunit => False); Get_File_Name (Bname, Subunit => False);
Error_Msg_N ("\but file{ was not found!", N); Error_Msg_N ("\but file{ was not found!", N);
raise Unrecoverable_Error; raise Unrecoverable_Error;
end if; end if;
......
...@@ -7214,10 +7214,14 @@ package body Sem_Util is ...@@ -7214,10 +7214,14 @@ package body Sem_Util is
function Is_VMS_Operator (Op : Entity_Id) return Boolean is function Is_VMS_Operator (Op : Entity_Id) return Boolean is
begin begin
-- The VMS operators are declared in a child of System that is loaded
-- through pragma Extend_System. In some rare cases a program is run
-- with this extension but without indicating that the target is VMS.
return Ekind (Op) = E_Function return Ekind (Op) = E_Function
and then Is_Intrinsic_Subprogram (Op) and then Is_Intrinsic_Subprogram (Op)
and then Chars (Scope (Scope (Op))) = Name_System and then Present_System_Aux
and then OpenVMS_On_Target; and then Scope (Op) = System_Aux_Id;
end Is_VMS_Operator; end Is_VMS_Operator;
----------------- -----------------
...@@ -7234,14 +7238,14 @@ package body Sem_Util is ...@@ -7234,14 +7238,14 @@ package body Sem_Util is
-- expansion. -- expansion.
function In_Protected_Function (E : Entity_Id) return Boolean; function In_Protected_Function (E : Entity_Id) return Boolean;
-- Within a protected function, the private components of the -- Within a protected function, the private components of the enclosing
-- enclosing protected type are constants. A function nested within -- protected type are constants. A function nested within a (protected)
-- a (protected) procedure is not itself protected. -- procedure is not itself protected.
function Is_Variable_Prefix (P : Node_Id) return Boolean; function Is_Variable_Prefix (P : Node_Id) return Boolean;
-- Prefixes can involve implicit dereferences, in which case we -- Prefixes can involve implicit dereferences, in which case we must
-- must test for the case of a reference of a constant access -- test for the case of a reference of a constant access type, which can
-- type, which can never be a variable. -- can never be a variable.
--------------------------- ---------------------------
-- In_Protected_Function -- -- In_Protected_Function --
...@@ -7257,9 +7261,7 @@ package body Sem_Util is ...@@ -7257,9 +7261,7 @@ package body Sem_Util is
else else
S := Current_Scope; S := Current_Scope;
while Present (S) and then S /= Prot loop while Present (S) and then S /= Prot loop
if Ekind (S) = E_Function if Ekind (S) = E_Function and then Scope (S) = Prot then
and then Scope (S) = Prot
then
return True; return True;
end if; end if;
...@@ -7304,16 +7306,16 @@ package body Sem_Util is ...@@ -7304,16 +7306,16 @@ package body Sem_Util is
if Nkind (N) in N_Subexpr and then Assignment_OK (N) then if Nkind (N) in N_Subexpr and then Assignment_OK (N) then
return True; return True;
-- Normally we go to the original node, but there is one exception -- Normally we go to the original node, but there is one exception where
-- where we use the rewritten node, namely when it is an explicit -- we use the rewritten node, namely when it is an explicit dereference.
-- dereference. The generated code may rewrite a prefix which is an -- The generated code may rewrite a prefix which is an access type with
-- access type with an explicit dereference. The dereference is a -- an explicit dereference. The dereference is a variable, even though
-- variable, even though the original node may not be (since it could -- the original node may not be (since it could be a constant of the
-- be a constant of the access type). -- access type).
-- In Ada 2005 we have a further case to consider: the prefix may be -- In Ada 2005 we have a further case to consider: the prefix may be a
-- a function call given in prefix notation. The original node appears -- function call given in prefix notation. The original node appears to
-- to be a selected component, but we need to examine the call. -- be a selected component, but we need to examine the call.
elsif Nkind (N) = N_Explicit_Dereference elsif Nkind (N) = N_Explicit_Dereference
and then Nkind (Orig_Node) /= N_Explicit_Dereference and then Nkind (Orig_Node) /= N_Explicit_Dereference
......
...@@ -627,6 +627,14 @@ package body Treepr is ...@@ -627,6 +627,14 @@ package body Treepr is
Print_Eol; Print_Eol;
end if; end if;
if Field_Present (Field28 (Ent)) then
Print_Str (Prefix);
Write_Field28_Name (Ent);
Write_Str (" = ");
Print_Field (Field28 (Ent));
Print_Eol;
end if;
Write_Entity_Flags (Ent, Prefix); Write_Entity_Flags (Ent, Prefix);
end Print_Entity_Info; end Print_Entity_Info;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment