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

5 files changed, 54 insertions, 25 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8e96bca..2a3c7b7 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,16 @@
 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.
 
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 24faf86..703db44 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -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 --
       ---------
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index e8c5808..41eb4ce 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -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 --
    ----------------------------
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index a2501ca..2e79e11 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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 --
    --------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 15232b9..95981da 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -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;