Commit ddc1515a by Arnaud Charlet

[multiple changes]

2010-10-11  Robert Dewar  <dewar@adacore.com>

	* sem_attr.adb: Minor reformatting.

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

	* sem_ch8.adb (Attribute_Renaming): Add missing check to avoid loading
	package System.Aux_Dec in VM platforms.

2010-10-11  Arnaud Charlet  <charlet@adacore.com>

	* sem_prag.adb (Process_Suppress_Unsuppress): Ignore
	Suppress/Unsuppress pragmas in codepeer mode.
	(Analyze_Pragma [Pragma_Suppress_All]): Do not generate error message in
	codepeer mode.
	* einfo.ads: Fix typo.

From-SVN: r165290
parent 1aa23421
2010-10-11 Robert Dewar <dewar@adacore.com>
* sem_attr.adb: Minor reformatting.
2010-10-11 Javier Miranda <miranda@adacore.com>
* sem_ch8.adb (Attribute_Renaming): Add missing check to avoid loading
package System.Aux_Dec in VM platforms.
2010-10-11 Arnaud Charlet <charlet@adacore.com>
* sem_prag.adb (Process_Suppress_Unsuppress): Ignore
Suppress/Unsuppress pragmas in codepeer mode.
(Analyze_Pragma [Pragma_Suppress_All]): Do not generate error message in
codepeer mode.
* einfo.ads: Fix typo.
2010-10-11 Emmanuel Briot <briot@adacore.com> 2010-10-11 Emmanuel Briot <briot@adacore.com>
* sinfo.adb: Use GNAT.HTable rather than System.HTable. * sinfo.adb: Use GNAT.HTable rather than System.HTable.
......
...@@ -2040,7 +2040,7 @@ package Einfo is ...@@ -2040,7 +2040,7 @@ package Einfo is
-- Is_Discrete_Type (synthesized) -- Is_Discrete_Type (synthesized)
-- Applies to all entities, true for all discrete types and subtypes -- Applies to all entities, true for all discrete types and subtypes
-- Is_Discrete__Or_Fixed_Point_Type (synthesized) -- Is_Discrete_Or_Fixed_Point_Type (synthesized)
-- Applies to all entities, true for all discrete types and subtypes -- Applies to all entities, true for all discrete types and subtypes
-- and all fixed-point types and subtypes. -- and all fixed-point types and subtypes.
......
...@@ -4456,12 +4456,15 @@ package body Sem_Attr is ...@@ -4456,12 +4456,15 @@ package body Sem_Attr is
when Attribute_Type_Key => when Attribute_Type_Key =>
Check_E0; Check_E0;
Check_Type; Check_Type;
-- This processing belongs in Eval_Attribute ???
declare declare
function Type_Key return String_Id; function Type_Key return String_Id;
-- A very preliminary implementation. -- A very preliminary implementation. For now, a signature
-- For now, a signature consists of only the type name. -- consists of only the type name. This is clearly incomplete
-- This is clearly incomplete (e.g., adding a new field to -- (e.g., adding a new field to a record type should change the
-- a record type should change the type's Type_Key attribute). -- type's Type_Key attribute).
-------------- --------------
-- Type_Key -- -- Type_Key --
...@@ -4470,6 +4473,7 @@ package body Sem_Attr is ...@@ -4470,6 +4473,7 @@ package body Sem_Attr is
function Type_Key return String_Id is function Type_Key return String_Id is
Full_Name : constant String_Id := Full_Name : constant String_Id :=
Fully_Qualified_Name_String (Entity (P)); Fully_Qualified_Name_String (Entity (P));
begin begin
-- Copy all characters in Full_Name but the trailing NUL -- Copy all characters in Full_Name but the trailing NUL
...@@ -4477,6 +4481,7 @@ package body Sem_Attr is ...@@ -4477,6 +4481,7 @@ package body Sem_Attr is
for J in 1 .. String_Length (Full_Name) - 1 loop for J in 1 .. String_Length (Full_Name) - 1 loop
Store_String_Char (Get_String_Char (Full_Name, Int (J))); Store_String_Char (Get_String_Char (Full_Name, Int (J)));
end loop; end loop;
Store_String_Chars ("'Type_Key"); Store_String_Chars ("'Type_Key");
return End_String; return End_String;
end Type_Key; end Type_Key;
......
...@@ -64,6 +64,7 @@ with Sinfo.CN; use Sinfo.CN; ...@@ -64,6 +64,7 @@ with Sinfo.CN; use Sinfo.CN;
with Snames; use Snames; with Snames; use Snames;
with Style; use Style; with Style; use Style;
with Table; with Table;
with Targparm; use Targparm;
with Tbuild; use Tbuild; with Tbuild; use Tbuild;
with Uintp; use Uintp; with Uintp; use Uintp;
...@@ -2933,7 +2934,11 @@ package body Sem_Ch8 is ...@@ -2933,7 +2934,11 @@ package body Sem_Ch8 is
-- type is still not frozen). We exclude from this processing generic -- type is still not frozen). We exclude from this processing generic
-- formal subprograms found in instantiations and AST_Entry renamings. -- formal subprograms found in instantiations and AST_Entry renamings.
if not Present (Corresponding_Formal_Spec (N)) -- We must exclude VM targets because entity AST_Handler is defined in
-- package System.Aux_Dec which is not available in those platforms.
if VM_Target = No_VM
and then not Present (Corresponding_Formal_Spec (N))
and then Etype (Nam) /= RTE (RE_AST_Handler) and then Etype (Nam) /= RTE (RE_AST_Handler)
then then
declare declare
......
...@@ -4689,6 +4689,13 @@ package body Sem_Prag is ...@@ -4689,6 +4689,13 @@ package body Sem_Prag is
-- Start of processing for Process_Suppress_Unsuppress -- Start of processing for Process_Suppress_Unsuppress
begin begin
-- Ignore pragma Suppress/Unsuppress in codepeer mode: we want to
-- generate checks for analysis purposes, as set by -gnatC.
if CodePeer_Mode then
return;
end if;
-- Suppress/Unsuppress can appear as a configuration pragma, or in a -- Suppress/Unsuppress can appear as a configuration pragma, or in a
-- declarative part or a package spec (RM 11.5(5)). -- declarative part or a package spec (RM 11.5(5)).
...@@ -11995,8 +12002,10 @@ package body Sem_Prag is ...@@ -11995,8 +12002,10 @@ package body Sem_Prag is
or else not Is_List_Member (N) or else not Is_List_Member (N)
or else List_Containing (N) /= Pragmas_After (Parent (N)) or else List_Containing (N) /= Pragmas_After (Parent (N))
then then
Error_Pragma if not CodePeer_Mode then
("misplaced pragma%, must follow compilation unit"); Error_Pragma
("misplaced pragma%, must follow compilation unit");
end if;
end if; end if;
------------------------- -------------------------
......
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