Put back previous change, the random failure was caused by a makefile bug,

causing the Ada run-time not to be recompiled by the new compiler.


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

1 files changed, 44 insertions, 51 deletions

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 2923aede4c5..787363898f5 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -1461,9 +1461,10 @@ 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 Boolean;
-         --  Returns True if N is an expression or a qualified expression with
-         --  an allocator.
+         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.
 
          procedure Check_Itype (Typ : Entity_Id);
          --  If the component subtype is an access to a constrained subtype of
@@ -1479,15 +1480,22 @@ package body Freeze is
          -- Check_Allocator --
          ---------------------
 
-         function Check_Allocator (N : Node_Id) return Boolean is
+         function Check_Allocator (N : Node_Id) return Node_Id is
+            Inner : Node_Id;
          begin
-            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;
+            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;
          end Check_Allocator;
 
          -----------------
@@ -1838,43 +1846,40 @@ 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 : Node_Id;
+                  Alloc : constant Node_Id :=
+                            Check_Allocator (Expression (Parent (Comp)));
 
                begin
-                  --  Handle qualified expressions
+                  if Present (Alloc) then
 
-                  Alloc := Expression (Parent (Comp));
-                  while Nkind (Alloc) /= N_Allocator loop
-                     pragma Assert (Nkind (Alloc) = N_Qualified_Expression);
-                     Alloc := Expression (Alloc);
-                  end loop;
-
-                  --  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 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
+                     if Is_Class_Wide_Type
+                          (Designated_Type (Etype (Comp)))
                      then
-                        Freeze_And_Append
-                         (Entity (Subtype_Mark (Expression (Alloc))),
-                           Loc, Result);
-                     end if;
+                        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;
 
-                  elsif Is_Itype (Designated_Type (Etype (Comp))) then
-                     Check_Itype (Etype (Comp));
+                     elsif Is_Itype (Designated_Type (Etype (Comp))) then
+                        Check_Itype (Etype (Comp));
 
-                  else
-                     Freeze_And_Append
-                       (Designated_Type (Etype (Comp)), Loc, Result);
+                     else
+                        Freeze_And_Append
+                          (Designated_Type (Etype (Comp)), Loc, Result);
+                     end if;
                   end if;
                end;
 
@@ -4697,18 +4702,6 @@ 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 =>