Skip to content

R
riscv-gcc-1
Commit 599a7411 by Arnaud Charlet
Options

[multiple changes] 

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

	* sem_attr.adb: Minor reformatting.
	* einfo.ads, einfo.adb (Is_Ada_2012_Only): New flag
	* itypes.adb (Create_Null_Excluding_Itype): Set Is_Ada_2012_Only flag
	properly.
	* lib-xref.adb (Generate_Reference): Warn on use of Ada 2012 entity in
	non-Ada 2012 mode.
	* opt.ads (Warn_On_Ada_2012_Compatibility): New flag
	* sem_ch3.adb (Analye_Subtype_Declaration): Inherit Is_Ada_2012_Only
	* sem_ch7.adb (Preserve_Full_Attributes): Preserve Is_Ada_2012_Only
	flag.
	* sem_prag.adb (Analyze_Pragma, case Ada_12/Ada_2012): Allow form with
	argument.
	* sem_type.adb (Disambiguate): Deal with Is_Ada_2012_Only.
	* sem_warn.adb (Warn_On_Ada_2012_Compatibility): New flag, treated
	same as 2005 flag.

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

	* a-tags.ads: Use new support for pragma Ada_2012 with function
	Type_Is_Abstract.

From-SVN: r165082
parent 0eb4c1a7
Showing with 128 additions and 18 deletions
gcc/ada/ChangeLog
2010-10-07 Robert Dewar <dewar@adacore.com>
* sem_attr.adb: Minor reformatting.
* einfo.ads, einfo.adb (Is_Ada_2012_Only): New flag
* itypes.adb (Create_Null_Excluding_Itype): Set Is_Ada_2012_Only flag
properly.
* lib-xref.adb (Generate_Reference): Warn on use of Ada 2012 entity in
non-Ada 2012 mode.
* opt.ads (Warn_On_Ada_2012_Compatibility): New flag
* sem_ch3.adb (Analye_Subtype_Declaration): Inherit Is_Ada_2012_Only
* sem_ch7.adb (Preserve_Full_Attributes): Preserve Is_Ada_2012_Only
flag.
* sem_prag.adb (Analyze_Pragma, case Ada_12/Ada_2012): Allow form with
argument.
* sem_type.adb (Disambiguate): Deal with Is_Ada_2012_Only.
* sem_warn.adb (Warn_On_Ada_2012_Compatibility): New flag, treated
same as 2005 flag.
2010-10-07 Javier Miranda <miranda@adacore.com>
* a-tags.ads: Use new support for pragma Ada_2012 with function
Type_Is_Abstract.
2010-10-07 Ed Schonberg <schonberg@adacore.com>
* par-ch5.adb (P_Sequence_Of_Statements): In Ada2012 a label can end a
......
gcc/ada/a-tags.ads
......@@ -76,7 +76,7 @@ package Ada.Tags is
pragma Ada_05 (Interface_Ancestor_Tags);
function Type_Is_Abstract (T : Tag) return Boolean;
pragma Ada_05 (Type_Is_Abstract);
pragma Ada_2012 (Type_Is_Abstract);
Tag_Error : exception;
......
gcc/ada/einfo.adb
......@@ -457,6 +457,7 @@ package body Einfo is
-- Was_Hidden Flag196
-- Is_Limited_Interface Flag197
-- Has_Pragma_Ordered Flag198
-- Is_Ada_2012_Only Flag199
-- Has_Anon_Block_Suffix Flag201
-- Itype_Printed Flag202
......@@ -510,7 +511,6 @@ package body Einfo is
-- Is_Underlying_Record_View Flag246
-- OK_To_Rename Flag247
-- (unused) Flag199
-- (unused) Flag200
-----------------------
......@@ -1609,6 +1609,11 @@ package body Einfo is
return Flag185 (Id);
end Is_Ada_2005_Only;
function Is_Ada_2012_Only (Id : E) return B is
begin
return Flag199 (Id);
end Is_Ada_2012_Only;
function Is_Aliased (Id : E) return B is
begin
pragma Assert (Nkind (Id) in N_Entity);
......@@ -4029,6 +4034,11 @@ package body Einfo is
Set_Flag185 (Id, V);
end Set_Is_Ada_2005_Only;
procedure Set_Is_Ada_2012_Only (Id : E; V : B := True) is
begin
Set_Flag199 (Id, V);
end Set_Is_Ada_2012_Only;
procedure Set_Is_Aliased (Id : E; V : B := True) is
begin
pragma Assert (Nkind (Id) in N_Entity);
......@@ -6958,6 +6968,7 @@ package body Einfo is
W ("Is_Local_Anonymous_Access", Flag194 (Id));
W ("Is_Access_Constant", Flag69 (Id));
W ("Is_Ada_2005_Only", Flag185 (Id));
W ("Is_Ada_2012_Only", Flag199 (Id));
W ("Is_Aliased", Flag15 (Id));
W ("Is_Asynchronous", Flag81 (Id));
W ("Is_Atomic", Flag85 (Id));
......
gcc/ada/einfo.ads
......@@ -1889,10 +1889,18 @@ package Einfo is
-- Applies to all entities, true for access types and subtypes
-- Is_Ada_2005_Only (Flag185)
-- Present in all entities, true if a valid pragma Ada_05 applies to the
-- entity which specifically names the entity, indicating that the entity
-- is Ada 2005 only. Note that this flag is not set if the entity is part
-- of a unit compiled with the normal no-argument form of pragma Ada_05.
-- Present in all entities, true if a valid pragma Ada_05 or Ada_2005
-- applies to the entity which specifically names the entity, indicating
-- that the entity is Ada 2005 only. Note that this flag is not set if
-- the entity is part of a unit compiled with the normal no-argument form
-- of pragma Ada_05 or Ada_2005.
-- Is_Ada_2012_Only (Flag199)
-- Present in all entities, true if a valid pragma Ada_12 or Ada_2012
-- applies to the entity which specifically names the entity, indicating
-- that the entity is Ada 2012 only. Note that this flag is not set if
-- the entity is part of a unit compiled with the normal no-argument form
-- of pragma Ada_12 or Ada_2012.
-- Is_Aliased (Flag15)
-- Present in objects whose declarations carry the keyword aliased,
......@@ -4589,6 +4597,7 @@ package Einfo is
-- Has_Xref_Entry (Flag182)
-- In_Private_Part (Flag45)
-- Is_Ada_2005_Only (Flag185)
-- Is_Ada_2012_Only (Flag199)
-- Is_Bit_Packed_Array (Flag122) (base type only)
-- Is_Character_Type (Flag63)
-- Is_Child_Unit (Flag73)
......@@ -5932,6 +5941,7 @@ package Einfo is
function Is_Abstract_Type (Id : E) return B;
function Is_Access_Constant (Id : E) return B;
function Is_Ada_2005_Only (Id : E) return B;
function Is_Ada_2012_Only (Id : E) return B;
function Is_Aliased (Id : E) return B;
function Is_Asynchronous (Id : E) return B;
function Is_Atomic (Id : E) return B;
......@@ -6493,6 +6503,7 @@ package Einfo is
procedure Set_Is_Abstract_Type (Id : E; V : B := True);
procedure Set_Is_Access_Constant (Id : E; V : B := True);
procedure Set_Is_Ada_2005_Only (Id : E; V : B := True);
procedure Set_Is_Ada_2012_Only (Id : E; V : B := True);
procedure Set_Is_Aliased (Id : E; V : B := True);
procedure Set_Is_Asynchronous (Id : E; V : B := True);
procedure Set_Is_Atomic (Id : E; V : B := True);
......@@ -7152,6 +7163,7 @@ package Einfo is
pragma Inline (Is_Abstract_Type);
pragma Inline (Is_Access_Constant);
pragma Inline (Is_Ada_2005_Only);
pragma Inline (Is_Ada_2012_Only);
pragma Inline (Is_Access_Type);
pragma Inline (Is_Access_Protected_Subprogram_Type);
pragma Inline (Is_Access_Subprogram_Type);
......@@ -7584,6 +7596,7 @@ package Einfo is
pragma Inline (Set_Is_Abstract_Type);
pragma Inline (Set_Is_Access_Constant);
pragma Inline (Set_Is_Ada_2005_Only);
pragma Inline (Set_Is_Ada_2012_Only);
pragma Inline (Set_Is_Aliased);
pragma Inline (Set_Is_Asynchronous);
pragma Inline (Set_Is_Atomic);
......
gcc/ada/itypes.adb
......@@ -112,6 +112,7 @@ package body Itypes is
Set_Treat_As_Volatile (I_Typ, Treat_As_Volatile (T));
Set_Is_Atomic (I_Typ, Is_Atomic (T));
Set_Is_Ada_2005_Only (I_Typ, Is_Ada_2005_Only (T));
Set_Is_Ada_2012_Only (I_Typ, Is_Ada_2012_Only (T));
Set_Can_Never_Be_Null (I_Typ);
return I_Typ;
......
gcc/ada/lib-xref.adb
......@@ -475,6 +475,18 @@ package body Lib.Xref is
Error_Msg_NE ("& is only defined in Ada 2005?", N, E);
end if;
-- Warn if reference to Ada 2012 entity not in Ada 2012 mode. We only
-- detect real explicit references (modifications and references).
if Comes_From_Source (N)
and then Is_Ada_2012_Only (E)
and then Ada_Version < Ada_12
and then Warn_On_Ada_2012_Compatibility
and then (Typ = 'm' or else Typ = 'r')
then
Error_Msg_NE ("& is only defined in Ada 2012?", N, E);
end if;
-- Never collect references if not in main source unit. However, we omit
-- this test if Typ is 'e' or 'k', since these entries are structural,
-- and it is useful to have them in units that reference packages as
......
gcc/ada/opt.ads
......@@ -1332,6 +1332,12 @@ package Opt is
-- including warnings on Ada 2005 obsolescent features used in Ada 2005
-- mode. Set False by -gnatwY.
Warn_On_Ada_2012_Compatibility : Boolean := True;
-- GNAT
-- Set to True to generate all warnings on Ada 2012 compatibility issues,
-- including warnings on Ada 2012 obsolescent features used in Ada 2012
-- mode. Set False by -gnatwY.
Warn_On_Parameter_Order : Boolean := False;
-- GNAT
-- Set to True to generate warnings for cases where the argument list for
......
gcc/ada/par-prag.adb
......@@ -323,11 +323,14 @@ begin
-- These pragmas must be processed at parse time, since we want to set
-- the Ada version properly at parse time to recognize the appropriate
-- Ada version syntax.
-- Ada version syntax. However, it is only the zero argument form that
-- must be processed at parse time.
when Pragma_Ada_12 | Pragma_Ada_2012 =>
if Arg_Count = 0 then
Ada_Version := Ada_12;
Ada_Version_Explicit := Ada_12;
end if;
-----------
-- Debug --
......
gcc/ada/sem_attr.adb
......@@ -7917,6 +7917,7 @@ package body Sem_Attr is
-- that generic unit. This includes any such attribute that
-- occurs within the body of a generic unit that is a child
-- of the generic unit where the subprogram is declared.
-- The rule also prohibits applying the attribute when the
-- access type is a generic formal access type (since the
-- level of the actual type is not known). This restriction
......
gcc/ada/sem_ch3.adb
......@@ -3466,6 +3466,7 @@ package body Sem_Ch3 is
Set_Treat_As_Volatile (Id, Treat_As_Volatile (T));
Set_Is_Atomic (Id, Is_Atomic (T));
Set_Is_Ada_2005_Only (Id, Is_Ada_2005_Only (T));
Set_Is_Ada_2012_Only (Id, Is_Ada_2012_Only (T));
Set_Convention (Id, Convention (T));
-- In the case where there is no constraint given in the subtype
......
gcc/ada/sem_ch7.adb
......@@ -2035,6 +2035,7 @@ package body Sem_Ch7 is
Set_Is_Volatile (Priv, Is_Volatile (Full));
Set_Treat_As_Volatile (Priv, Treat_As_Volatile (Full));
Set_Is_Ada_2005_Only (Priv, Is_Ada_2005_Only (Full));
Set_Is_Ada_2012_Only (Priv, Is_Ada_2012_Only (Full));
Set_Has_Pragma_Unmodified (Priv, Has_Pragma_Unmodified (Full));
Set_Has_Pragma_Unreferenced (Priv, Has_Pragma_Unreferenced (Full));
Set_Has_Pragma_Unreferenced_Objects
......
gcc/ada/sem_prag.adb
......@@ -5344,7 +5344,7 @@ package body Sem_Prag is
-- pragma Ada_2005;
-- pragma Ada_2005 (LOCAL_NAME):
-- Note: these pragma also have some specific processing in Par.Prag
-- Note: these pragmas also have some specific processing in Par.Prag
-- because we want to set the Ada 2005 version mode during parsing.
when Pragma_Ada_05 | Pragma_Ada_2005 => declare
......@@ -5386,20 +5386,39 @@ package body Sem_Prag is
---------------------
-- pragma Ada_12;
-- pragma Ada_12 (LOCAL_NAME);
-- pragma Ada_2012;
-- pragma Ada_2012 (LOCAL_NAME):
-- Note: these pragma also have some specific processing in Par.Prag
-- Note: these pragmas also have some specific processing in Par.Prag
-- because we want to set the Ada 2012 version mode during parsing.
when Pragma_Ada_12 | Pragma_Ada_2012 =>
when Pragma_Ada_12 | Pragma_Ada_2012 => declare
E_Id : Node_Id;
begin
GNAT_Pragma;
if Arg_Count = 1 then
Check_Arg_Is_Local_Name (Arg1);
E_Id := Expression (Arg1);
if Etype (E_Id) = Any_Type then
return;
end if;
Set_Is_Ada_2012_Only (Entity (E_Id));
else
Check_Arg_Count (0);
-- For Ada_2012 we unconditionally enforce the documented
-- configuration pragma placement, since we do not want to
-- tolerate mixed modes in a unit involving Ada 2012. That would
-- cause real difficulties for those cases where there are
-- incompatibilities between Ada 95 and Ada 2005/Ada 2012.
-- tolerate mixed modes in a unit involving Ada 2012. That
-- would cause real difficulties for those cases where there
-- are incompatibilities between Ada 95 and Ada 2012. We could
-- allow mixing of Ada 2005 and Ada 2012 but it's not worth it.
Check_Valid_Configuration_Pragma;
......@@ -5407,6 +5426,8 @@ package body Sem_Prag is
Ada_Version := Ada_12;
Ada_Version_Explicit := Ada_12;
end if;
end;
----------------------
-- All_Calls_Remote --
......
gcc/ada/sem_type.adb
......@@ -1533,15 +1533,26 @@ package body Sem_Type is
It2 := It;
Nam2 := It.Nam;
-- Check whether one of the entities is an Ada 2005/2012 and we are
-- operating in an earlier mode, in which case we discard the Ada
-- 2005/2012 entity, so that we get proper Ada 95 overload resolution.
if Ada_Version < Ada_05 then
if Is_Ada_2005_Only (Nam1) or else Is_Ada_2012_Only (Nam1) then
return It2;
elsif Is_Ada_2005_Only (Nam2) or else Is_Ada_2012_Only (Nam1) then
return It1;
end if;
end if;
-- Check whether one of the entities is an Ada 2005 entity and we are
-- operating in an earlier mode, in which case we discard the Ada
-- 2005 entity, so that we get proper Ada 95 overload resolution.
-- Check whether one of the entities is an Ada 2012 entity and we are
-- operating in Ada 2005 mode, in which case we discard the Ada 2012
-- entity, so that we get proper Ada 2005 overload resolution.
if Is_Ada_2005_Only (Nam1) then
if Ada_Version = Ada_05 then
if Is_Ada_2012_Only (Nam1) then
return It2;
elsif Is_Ada_2005_Only (Nam2) then
elsif Is_Ada_2012_Only (Nam2) then
return It1;
end if;
end if;
......
gcc/ada/sem_warn.adb
......@@ -3069,6 +3069,7 @@ package body Sem_Warn is
Implementation_Unit_Warnings := True;
Ineffective_Inline_Warnings := True;
Warn_On_Ada_2005_Compatibility := True;
Warn_On_Ada_2012_Compatibility := True;
Warn_On_All_Unread_Out_Parameters := True;
Warn_On_Assertion_Failure := True;
Warn_On_Assumed_Low_Bound := True;
......@@ -3189,6 +3190,7 @@ package body Sem_Warn is
Implementation_Unit_Warnings := False;
Ineffective_Inline_Warnings := True;
Warn_On_Ada_2005_Compatibility := True;
Warn_On_Ada_2012_Compatibility := True;
Warn_On_All_Unread_Out_Parameters := False;
Warn_On_Assertion_Failure := True;
Warn_On_Assumed_Low_Bound := True;
......@@ -3230,6 +3232,7 @@ package body Sem_Warn is
Implementation_Unit_Warnings := True;
Ineffective_Inline_Warnings := True;
Warn_On_Ada_2005_Compatibility := True;
Warn_On_Ada_2012_Compatibility := True;
Warn_On_Assertion_Failure := True;
Warn_On_Assumed_Low_Bound := True;
Warn_On_Bad_Fixed_Value := True;
......@@ -3259,6 +3262,7 @@ package body Sem_Warn is
Implementation_Unit_Warnings := False;
Ineffective_Inline_Warnings := False;
Warn_On_Ada_2005_Compatibility := False;
Warn_On_Ada_2012_Compatibility := False;
Warn_On_All_Unread_Out_Parameters := False;
Warn_On_Assertion_Failure := False;
Warn_On_Assumed_Low_Bound := False;
......@@ -3424,9 +3428,11 @@ package body Sem_Warn is
when 'y' =>
Warn_On_Ada_2005_Compatibility := True;
Warn_On_Ada_2012_Compatibility := True;
when 'Y' =>
Warn_On_Ada_2005_Compatibility := False;
Warn_On_Ada_2012_Compatibility := False;
when 'z' =>
Warn_On_Unchecked_Conversion := True;
......
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