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

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8e96bcae11542854f1817546bb5db908fc216f6a..2a3c7b7208bf23a0a08efaa25b3f0b30d6fe0854 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+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

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 24faf86c833013ec6464be021181c198745cceed..703db44c77f33218c1069491bccb54995ad9abcf 100644 (file)
--- 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 e8c580851bf641c25d108eea9bf642de318618fa..41eb4ced2100394ba570809e97eace713bcf69e1 100644 (file)
--- 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 a2501cadbffc504cd83069f410676e6a83ee2d50..2e79e110c1c1cb2fd2c1b55a54cf16d8f4b0dd81 100644 (file)
--- 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 15232b953288dba23af0b12ca7eedc82c4e69c9a..95981da0cc0015c333fbbac66ed71c6e64fe9656 100644 (file)
--- 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;