Commit 428684fd by Robert Dewar Committed by Arnaud Charlet

sem_attr.adb (Analyze_Attribute, case Max): Check for improper comparison of…

sem_attr.adb (Analyze_Attribute, case Max): Check for improper comparison of unordered enumeration type.

2014-02-06  Robert Dewar  <dewar@adacore.com>

	* sem_attr.adb (Analyze_Attribute, case Max): Check for improper
	comparison of unordered enumeration type.
	(Analyze_Attribute, case Max): Check for improper comparison of
	unordered enumeration type.
	* sem_res.adb (Bad_Unordered_Enumeration_Reference): Moved to
	sem_util.adb.
	* sem_util.ads, sem_util.adb (Bad_Unordered_Enumeration_Reference):
	Moved here from Sem_Res.

From-SVN: r207556
parent 8c35b40a
2014-02-06 Robert Dewar <dewar@adacore.com>
* sem_attr.adb (Analyze_Attribute, case Max): Check for improper
comparison of unordered enumeration type.
(Analyze_Attribute, case Max): Check for improper comparison of
unordered enumeration type.
* sem_res.adb (Bad_Unordered_Enumeration_Reference): Moved to
sem_util.adb.
* sem_util.ads, sem_util.adb (Bad_Unordered_Enumeration_Reference):
Moved here from Sem_Res.
2014-02-06 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_prag.adb, sem_res.adb, lib-xref.adb: Minor
reformatting.
......
......@@ -4113,6 +4113,15 @@ package body Sem_Attr is
Resolve (E2, P_Base_Type);
Set_Etype (N, P_Base_Type);
-- Check for comparison on unordered enumeration type
if Bad_Unordered_Enumeration_Reference (N, P_Base_Type) then
Error_Msg_Sloc := Sloc (P_Base_Type);
Error_Msg_NE
("comparison on unordered enumeration type& declared#?U?",
N, P_Base_Type);
end if;
----------------------------------
-- Max_Alignment_For_Allocation --
-- Max_Size_In_Storage_Elements --
......@@ -4174,6 +4183,15 @@ package body Sem_Attr is
Resolve (E2, P_Base_Type);
Set_Etype (N, P_Base_Type);
-- Check for comparison on unordered enumeration type
if Bad_Unordered_Enumeration_Reference (N, P_Base_Type) then
Error_Msg_Sloc := Sloc (P_Base_Type);
Error_Msg_NE
("comparison on unordered enumeration type& declared#?U?",
N, P_Base_Type);
end if;
---------
-- Mod --
---------
......
......@@ -93,15 +93,6 @@ package body Sem_Res is
-- Note that Resolve_Attribute is separated off in Sem_Attr
function Bad_Unordered_Enumeration_Reference
(N : Node_Id;
T : Entity_Id) return Boolean;
-- Node N contains a potentially dubious reference to type T, either an
-- explicit comparison, or an explicit range. This function returns True
-- if the type T is an enumeration type for which No pragma Order has been
-- given, and the reference N is not in the same extended source unit as
-- the declaration of T.
procedure Check_Discriminant_Use (N : Node_Id);
-- Enforce the restrictions on the use of discriminants when constraining
-- a component of a discriminated type (record or concurrent type).
......@@ -397,22 +388,6 @@ package body Sem_Res is
end if;
end Analyze_And_Resolve;
----------------------------------------
-- Bad_Unordered_Enumeration_Reference --
----------------------------------------
function Bad_Unordered_Enumeration_Reference
(N : Node_Id;
T : Entity_Id) return Boolean
is
begin
return Is_Enumeration_Type (T)
and then Comes_From_Source (N)
and then Warn_On_Unordered_Enumeration_Type
and then not Has_Pragma_Ordered (T)
and then not In_Same_Extended_Unit (N, T);
end Bad_Unordered_Enumeration_Reference;
----------------------------
-- Check_Discriminant_Use --
----------------------------
......
......@@ -669,6 +669,22 @@ package body Sem_Util is
end if;
end Bad_Predicated_Subtype_Use;
----------------------------------------
-- Bad_Unordered_Enumeration_Reference --
----------------------------------------
function Bad_Unordered_Enumeration_Reference
(N : Node_Id;
T : Entity_Id) return Boolean
is
begin
return Is_Enumeration_Type (T)
and then Comes_From_Source (N)
and then Warn_On_Unordered_Enumeration_Type
and then not Has_Pragma_Ordered (T)
and then not In_Same_Extended_Unit (N, T);
end Bad_Unordered_Enumeration_Reference;
--------------------------
-- Build_Actual_Subtype --
--------------------------
......
......@@ -171,6 +171,15 @@ package Sem_Util is
-- Suggest_Static when the context warrants an advice on how to avoid the
-- use error.
function Bad_Unordered_Enumeration_Reference
(N : Node_Id;
T : Entity_Id) return Boolean;
-- Node N contains a potentially dubious reference to type T, either an
-- explicit comparison, or an explicit range. This function returns True
-- if the type T is an enumeration type for which No pragma Order has been
-- given, and the reference N is not in the same extended source unit as
-- the declaration of T.
function Build_Actual_Subtype
(T : Entity_Id;
N : Node_Or_Entity_Id) return Node_Id;
......
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