2011-08-02 Robert Dewar <dewar@adacore.com>

	* sem_ch8.adb: Minor code reorganization, comment updates.

2011-08-02  Robert Dewar  <dewar@adacore.com>

	* sem_res.adb (Matching_Static_Array_Bounds): Moved to Sem_Util
	* sem_util.ads, sem_util.adb (Matching_Static_Array_Bounds): Moved
	here from Sem_Res.
	(Matching_Static_Array_Bounds): Use Is_Ok_Static_Expression
	(Matching_Static_Array_Bounds): Moved here from Sem_Res

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177091 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fb77921..ae47e20 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2011-08-02  Robert Dewar  <dewar@adacore.com>
+
+       * sem_ch8.adb: Minor code reorganization, comment updates.
+
+2011-08-02  Robert Dewar  <dewar@adacore.com>
+
+       * sem_res.adb (Matching_Static_Array_Bounds): Moved to Sem_Util
+       * sem_util.ads, sem_util.adb (Matching_Static_Array_Bounds): Moved
+       here from Sem_Res.
+       (Matching_Static_Array_Bounds): Use Is_Ok_Static_Expression
+       (Matching_Static_Array_Bounds): Moved here from Sem_Res
+
 2011-08-02  Ed Schonberg  <schonberg@adacore.com>
 
        * atree.h, atree.ads, atree.adb: New subprograms to manipulate Elist5.

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index ad87c6f..7f4e4b1 100644 (file)
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -2679,9 +2679,13 @@ package body Sem_Ch8 is
          Chain_Use_Clause (N);
       end if;
 
-      --  Commented needed???
+      --  If the Used_Operations list is already initialized, the clause has
+      --  been analyzed previously, and it is begin reinstalled, for example
+      --  when the clause appears in a package spec and we are compiling the
+      --  corresponding package body. In that case, make the entities on the
+      --  existing list use-visible.
 
-      if Used_Operations (N) /= No_Elist then
+      if Present (Used_Operations (N)) then
          declare
             Elmt : Elmt_Id;
          begin
@@ -2695,6 +2699,9 @@ package body Sem_Ch8 is
          return;
       end if;
 
+      --  Otherwise, create new list and attach to it the operations that
+      --  are made use-visible by the clause.
+
       Set_Used_Operations (N, New_Elmt_List);
       Id := First (Subtype_Marks (N));
       while Present (Id) loop

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 495b260..7f71d1b 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -92,12 +92,6 @@ package body Sem_Res is
 
    --  Note that Resolve_Attribute is separated off in Sem_Attr
 
-   function Matching_Static_Array_Bounds
-     (L_Typ : Node_Id;
-      R_Typ : Node_Id) return Boolean;
-   --  L_Typ and R_Typ are two array types. Returns True when they have the
-   --  same dimension, and, for each index position, the same static bounds.
-
    function Bad_Unordered_Enumeration_Reference
      (N : Node_Id;
       T : Entity_Id) return Boolean;
@@ -1577,65 +1571,6 @@ package body Sem_Res is
       end if;
    end Make_Call_Into_Operator;
 
-   ----------------------------------
-   -- Matching_Static_Array_Bounds --
-   ----------------------------------
-
-   function Matching_Static_Array_Bounds
-     (L_Typ : Node_Id;
-      R_Typ : Node_Id) return Boolean
-   is
-      L_Ndims : constant Nat := Number_Dimensions (L_Typ);
-      R_Ndims : constant Nat := Number_Dimensions (R_Typ);
-
-      L_Index : Node_Id;
-      R_Index : Node_Id;
-      L_Low   : Node_Id;
-      L_High  : Node_Id;
-      R_Low   : Node_Id;
-      R_High  : Node_Id;
-
-   begin
-      if L_Ndims /= R_Ndims then
-         return False;
-      end if;
-
-      --  Unconstrained types do not have static bounds
-
-      if not Is_Constrained (L_Typ) or else not Is_Constrained (R_Typ) then
-         return False;
-      end if;
-
-      L_Index := First_Index (L_Typ);
-      R_Index := First_Index (R_Typ);
-
-      for Indx in 1 .. L_Ndims loop
-         Get_Index_Bounds (L_Index, L_Low, L_High);
-         Get_Index_Bounds (R_Index, R_Low, R_High);
-
-         if True
-           and then Is_Static_Expression (L_Low)
-           and then Is_Static_Expression (L_High)
-           and then Is_Static_Expression (R_Low)
-           and then Is_Static_Expression (R_High)
-           and then Expr_Value (L_Low)  = Expr_Value (R_Low)
-           and then Expr_Value (L_High) = Expr_Value (R_High)
-         then
-            --  Matching so far, continue with next index
-
-            null;
-
-         else
-            return False;
-         end if;
-
-         Next (L_Index);
-         Next (R_Index);
-      end loop;
-
-      return True;
-   end Matching_Static_Array_Bounds;
-
    -------------------
    -- Operator_Kind --
    -------------------
@@ -3634,15 +3569,16 @@ package body Sem_Res is
                   Operand     : constant Node_Id   := Expression (A);
                   Operand_Typ : constant Entity_Id := Etype (Operand);
                   Target_Typ  : constant Entity_Id := A_Typ;
+
                begin
                   if not (Is_Tagged_Type (Target_Typ)
-                          and then not Is_Class_Wide_Type (Target_Typ)
-                          and then Is_Tagged_Type (Operand_Typ)
-                          and then not Is_Class_Wide_Type (Operand_Typ)
-                          and then Is_Ancestor (Target_Typ, Operand_Typ))
+                           and then not Is_Class_Wide_Type (Target_Typ)
+                           and then Is_Tagged_Type (Operand_Typ)
+                           and then not Is_Class_Wide_Type (Operand_Typ)
+                           and then Is_Ancestor (Target_Typ, Operand_Typ))
                   then
                      Error_Msg_F ("|~~ancestor conversion is the only "
-                                  & "view conversion", A);
+                                  & "permitted view conversion", A);
                   end if;
                end;
             end if;
@@ -4893,7 +4829,7 @@ package body Sem_Res is
 
       if Formal_Verification_Mode
         and then (Is_Fixed_Point_Type (Etype (L))
-                  or else Is_Fixed_Point_Type (Etype (R)))
+                   or else Is_Fixed_Point_Type (Etype (R)))
         and then Nkind_In (N, N_Op_Multiply, N_Op_Divide)
         and then
           not Nkind_In (Parent (N), N_Qualified_Expression, N_Type_Conversion)
@@ -4921,10 +4857,10 @@ package body Sem_Res is
 
             if Compile_Time_Known_Value (Rop)
               and then ((Is_Integer_Type (Etype (Rop))
-                           and then Expr_Value (Rop) = Uint_0)
-                          or else
-                        (Is_Real_Type (Etype (Rop))
-                           and then Expr_Value_R (Rop) = Ureal_0))
+                          and then Expr_Value (Rop) = Uint_0)
+                         or else
+                           (Is_Real_Type (Etype (Rop))
+                             and then Expr_Value_R (Rop) = Ureal_0))
             then
                --  Specialize the warning message according to the operation
 
@@ -5911,7 +5847,8 @@ package body Sem_Res is
            and then Base_Type (T) /= Standard_String
          then
             Error_Msg_F
-              ("|~~comparison is not defined on array type except String", N);
+              ("|~~comparison is not defined on array types " &
+               "other than String", N);
          end if;
       end if;
 

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 6645688..78348d4 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -7998,6 +7998,62 @@ package body Sem_Util is
       return N;
    end Last_Source_Statement;
 
+   ----------------------------------
+   -- Matching_Static_Array_Bounds --
+   ----------------------------------
+
+   function Matching_Static_Array_Bounds
+     (L_Typ : Node_Id;
+      R_Typ : Node_Id) return Boolean
+   is
+      L_Ndims : constant Nat := Number_Dimensions (L_Typ);
+      R_Ndims : constant Nat := Number_Dimensions (R_Typ);
+
+      L_Index : Node_Id;
+      R_Index : Node_Id;
+      L_Low   : Node_Id;
+      L_High  : Node_Id;
+      R_Low   : Node_Id;
+      R_High  : Node_Id;
+
+   begin
+      if L_Ndims /= R_Ndims then
+         return False;
+      end if;
+
+      --  Unconstrained types do not have static bounds
+
+      if not Is_Constrained (L_Typ) or else not Is_Constrained (R_Typ) then
+         return False;
+      end if;
+
+      L_Index := First_Index (L_Typ);
+      R_Index := First_Index (R_Typ);
+
+      for Indx in 1 .. L_Ndims loop
+         Get_Index_Bounds (L_Index, L_Low, L_High);
+         Get_Index_Bounds (R_Index, R_Low, R_High);
+
+         if         Is_OK_Static_Expression (L_Low)
+           and then Is_OK_Static_Expression (L_High)
+           and then Is_OK_Static_Expression (R_Low)
+           and then Is_OK_Static_Expression (R_High)
+           and then Expr_Value (L_Low)  = Expr_Value (R_Low)
+           and then Expr_Value (L_High) = Expr_Value (R_High)
+         then
+            Next (L_Index);
+            Next (R_Index);
+
+         else
+            return False;
+         end if;
+      end loop;
+
+      --  If we fall through the loop, all indexes matched
+
+      return True;
+   end Matching_Static_Array_Bounds;
+
    -------------------
    -- May_Be_Lvalue --
    -------------------

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index bb4e1c2..6410db4 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -939,6 +939,13 @@ package Sem_Util is
    --  See Sinfo. We rename Make_Return_Statement to the correct Ada 2005
    --  terminology here. Clients should use Make_Simple_Return_Statement.
 
+   function Matching_Static_Array_Bounds
+     (L_Typ : Node_Id;
+      R_Typ : Node_Id) return Boolean;
+   --  L_Typ and R_Typ are two array types. Returns True when they have the
+   --  same number of dimensions, and the same static bounds for each index
+   --  position.
+
    Make_Return_Statement : constant := -2 ** 33;
    --  Attempt to prevent accidental uses of Make_Return_Statement. If this
    --  and the one in Nmake are both potentially use-visible, it will cause