Temporarily undo previous change, which seems to be causing random

failures.


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

1 files changed, 51 insertions, 44 deletions

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 787363898f5..2923aede4c5 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -1461,10 +1461,9 @@ package body Freeze is
          --  Set True if we find at least one component with a component
          --  clause (used to warn about useless Bit_Order pragmas).
 
-         function Check_Allocator (N : Node_Id) return Node_Id;
-         --  If N is an allocator, possibly wrapped in one or more level of
-         --  qualified expression(s), return the inner allocator node, else
-         --  return Empty.
+         function Check_Allocator (N : Node_Id) return Boolean;
+         --  Returns True if N is an expression or a qualified expression with
+         --  an allocator.
 
          procedure Check_Itype (Typ : Entity_Id);
          --  If the component subtype is an access to a constrained subtype of
@@ -1480,22 +1479,15 @@ package body Freeze is
          -- Check_Allocator --
          ---------------------
 
-         function Check_Allocator (N : Node_Id) return Node_Id is
-            Inner : Node_Id;
+         function Check_Allocator (N : Node_Id) return Boolean is
          begin
-            Inner := N;
-
-            loop
-               if Nkind (Inner) = N_Allocator then
-                  return Inner;
-
-               elsif Nkind (Inner) = N_Qualified_Expression then
-                  Inner := Expression (Inner);
-
-               else
-                  return Empty;
-               end if;
-            end loop;
+            if Nkind (N) = N_Allocator then
+               return True;
+            elsif Nkind (N) = N_Qualified_Expression then
+               return Check_Allocator (Expression (N));
+            else
+               return False;
+            end if;
          end Check_Allocator;
 
          -----------------
@@ -1846,40 +1838,43 @@ package body Freeze is
             elsif Is_Access_Type (Etype (Comp))
               and then Present (Parent (Comp))
               and then Present (Expression (Parent (Comp)))
+              and then Check_Allocator (Expression (Parent (Comp)))
             then
                declare
-                  Alloc : constant Node_Id :=
-                            Check_Allocator (Expression (Parent (Comp)));
+                  Alloc : Node_Id;
 
                begin
-                  if Present (Alloc) then
+                  --  Handle qualified expressions
 
-                     --  If component is pointer to a classwide type, freeze
-                     --  the specific type in the expression being allocated.
-                     --  The expression may be a subtype indication, in which
-                     --  case freeze the subtype mark.
-
-                     if Is_Class_Wide_Type
-                          (Designated_Type (Etype (Comp)))
-                     then
-                        if Is_Entity_Name (Expression (Alloc)) then
-                           Freeze_And_Append
-                             (Entity (Expression (Alloc)), Loc, Result);
-                        elsif
-                          Nkind (Expression (Alloc)) = N_Subtype_Indication
-                        then
-                           Freeze_And_Append
-                            (Entity (Subtype_Mark (Expression (Alloc))),
-                              Loc, Result);
-                        end if;
+                  Alloc := Expression (Parent (Comp));
+                  while Nkind (Alloc) /= N_Allocator loop
+                     pragma Assert (Nkind (Alloc) = N_Qualified_Expression);
+                     Alloc := Expression (Alloc);
+                  end loop;
 
-                     elsif Is_Itype (Designated_Type (Etype (Comp))) then
-                        Check_Itype (Etype (Comp));
+                  --  If component is pointer to a classwide type, freeze the
+                  --  specific type in the expression being allocated. The
+                  --  expression may be a subtype indication, in which case
+                  --  freeze the subtype mark.
 
-                     else
+                  if Is_Class_Wide_Type (Designated_Type (Etype (Comp))) then
+                     if Is_Entity_Name (Expression (Alloc)) then
                         Freeze_And_Append
-                          (Designated_Type (Etype (Comp)), Loc, Result);
+                          (Entity (Expression (Alloc)), Loc, Result);
+                     elsif
+                       Nkind (Expression (Alloc)) = N_Subtype_Indication
+                     then
+                        Freeze_And_Append
+                         (Entity (Subtype_Mark (Expression (Alloc))),
+                           Loc, Result);
                      end if;
+
+                  elsif Is_Itype (Designated_Type (Etype (Comp))) then
+                     Check_Itype (Etype (Comp));
+
+                  else
+                     Freeze_And_Append
+                       (Designated_Type (Etype (Comp)), Loc, Result);
                   end if;
                end;
 
@@ -4702,6 +4697,18 @@ package body Freeze is
    begin
       Ensure_Type_Is_SA (Etype (E));
 
+      --  Reset True_Constant flag, since something strange is going on with
+      --  the scoping here, and our simple value tracing may not be sufficient
+      --  for this indication to be reliable. We kill the Constant_Value
+      --  and Last_Assignment indications for the same reason.
+
+      Set_Is_True_Constant (E, False);
+      Set_Current_Value    (E, Empty);
+
+      if Ekind (E) = E_Variable then
+         Set_Last_Assignment  (E, Empty);
+      end if;
+
    exception
       when Cannot_Be_Static =>