Patch to fix -mcpu=G5 interface to EH runtime library.

[pf3gnuchains/gcc-fork.git] / gcc / ada / sprint.adb

diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 10cad35..0d81444 100644 (file)
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -692,10 +692,37 @@ package body Sprint is
             Write_Char (';');
 
          when N_Access_Definition =>
-            Write_Str_With_Col_Check_Sloc ("access ");
-            Sprint_Node (Subtype_Mark (Node));
+
+            --  Ada 2005 (AI-254)
+
+            if Present (Access_To_Subprogram_Definition (Node)) then
+               Sprint_Node (Access_To_Subprogram_Definition (Node));
+            else
+               --  Ada 2005 (AI-231)
+
+               if Null_Exclusion_Present (Node) then
+                  Write_Str ("not null ");
+               end if;
+
+               Write_Str_With_Col_Check_Sloc ("access ");
+
+               if All_Present (Node) then
+                  Write_Str ("all ");
+               elsif Constant_Present (Node) then
+                  Write_Str ("constant ");
+               end if;
+
+               Sprint_Node (Subtype_Mark (Node));
+            end if;
 
          when N_Access_Function_Definition =>
+
+            --  Ada 2005 (AI-231)
+
+            if Null_Exclusion_Present (Node) then
+               Write_Str ("not null ");
+            end if;
+
             Write_Str_With_Col_Check_Sloc ("access ");
 
             if Protected_Present (Node) then
@@ -708,6 +735,13 @@ package body Sprint is
             Sprint_Node (Subtype_Mark (Node));
 
          when N_Access_Procedure_Definition =>
+
+            --  Ada 2005 (AI-231)
+
+            if Null_Exclusion_Present (Node) then
+               Write_Str ("not null ");
+            end if;
+
             Write_Str_With_Col_Check_Sloc ("access ");
 
             if Protected_Present (Node) then
@@ -726,6 +760,12 @@ package body Sprint is
                Write_Str_With_Col_Check ("constant ");
             end if;
 
+            --  Ada 2005 (AI-231)
+
+            if Null_Exclusion_Present (Node) then
+               Write_Str ("not null ");
+            end if;
+
             Sprint_Node (Subtype_Indication (Node));
 
          when N_Aggregate =>
@@ -774,6 +814,13 @@ package body Sprint is
 
          when N_Allocator =>
             Write_Str_With_Col_Check_Sloc ("new ");
+
+            --  Ada 2005 (AI-231)
+
+            if Null_Exclusion_Present (Node) then
+               Write_Str ("not null ");
+            end if;
+
             Sprint_Node (Expression (Node));
 
             if Present (Storage_Pool (Node)) then
@@ -929,7 +976,7 @@ package body Sprint is
             Sprint_Bar_List (Choices (Node));
             Write_Str (" => ");
 
-            --  Ada0Y (AI-287): Print the mbox if present
+            --  Ada 2005 (AI-287): Print the mbox if present
 
             if Box_Present (Node) then
                Write_Str_With_Col_Check ("<>");
@@ -952,11 +999,27 @@ package body Sprint is
          when N_Component_Definition =>
             Set_Debug_Sloc;
 
-            if Aliased_Present (Node) then
-               Write_Str_With_Col_Check ("aliased ");
-            end if;
+            --  Ada 2005 (AI-230): Access definition components
 
-            Sprint_Node (Subtype_Indication (Node));
+            if Present (Access_Definition (Node)) then
+               Sprint_Node (Access_Definition (Node));
+
+            elsif Present (Subtype_Indication (Node)) then
+               if Aliased_Present (Node) then
+                  Write_Str_With_Col_Check ("aliased ");
+               end if;
+
+               --  Ada 2005 (AI-231)
+
+               if Null_Exclusion_Present (Node) then
+                  Write_Str (" not null ");
+               end if;
+
+               Sprint_Node (Subtype_Indication (Node));
+
+            else
+               Write_Str (" ??? ");
+            end if;
 
          when N_Component_Declaration =>
             if Write_Indent_Identifiers_Sloc (Node) then
@@ -1074,6 +1137,13 @@ package body Sprint is
             end if;
 
             Write_Str_With_Col_Check_Sloc ("new ");
+
+            --  Ada 2005 (AI-231)
+
+            if Null_Exclusion_Present (Node) then
+               Write_Str_With_Col_Check ("not null ");
+            end if;
+
             Sprint_Node (Subtype_Indication (Node));
 
             if Present (Record_Extension_Part (Node)) then
@@ -1107,6 +1177,11 @@ package body Sprint is
 
             if Write_Identifiers (Node) then
                Write_Str (" : ");
+
+               if Null_Exclusion_Present (Node) then
+                  Write_Str ("not null ");
+               end if;
+
                Sprint_Node (Discriminant_Type (Node));
 
                if Present (Expression (Node)) then
@@ -1678,6 +1753,12 @@ package body Sprint is
                   Write_Str_With_Col_Check ("constant ");
                end if;
 
+               --  Ada 2005 (AI-231)
+
+               if Null_Exclusion_Present (Node) then
+                  Write_Str_With_Col_Check ("not null ");
+               end if;
+
                Sprint_Node (Object_Definition (Node));
 
                if Present (Expression (Node)) then
@@ -1693,7 +1774,19 @@ package body Sprint is
             Set_Debug_Sloc;
             Sprint_Node (Defining_Identifier (Node));
             Write_Str (" : ");
-            Sprint_Node (Subtype_Mark (Node));
+
+            --  Ada 2005 (AI-230): Access renamings
+
+            if Present (Access_Definition (Node)) then
+               Sprint_Node (Access_Definition (Node));
+
+            elsif Present (Subtype_Mark (Node)) then
+               Sprint_Node (Subtype_Mark (Node));
+
+            else
+               Write_Str (" ??? ");
+            end if;
+
             Write_Str_With_Col_Check (" renames ");
             Sprint_Node (Name (Node));
             Write_Char (';');
@@ -1919,6 +2012,12 @@ package body Sprint is
                   Write_Str_With_Col_Check ("out ");
                end if;
 
+               --  Ada 2005 (AI-231)
+
+               if Null_Exclusion_Present (Node) then
+                  Write_Str ("not null ");
+               end if;
+
                Sprint_Node (Parameter_Type (Node));
 
                if Present (Expression (Node)) then
@@ -2303,6 +2402,13 @@ package body Sprint is
             Write_Indent_Str_Sloc ("subtype ");
             Write_Id (Defining_Identifier (Node));
             Write_Str (" is ");
+
+            --  Ada 2005 (AI-231)
+
+            if Null_Exclusion_Present (Node) then
+               Write_Str ("not null ");
+            end if;
+
             Sprint_Node (Subtype_Indication (Node));
             Write_Char (';');
 
@@ -2349,6 +2455,7 @@ package body Sprint is
             Write_Indent_Str_Sloc ("task type ");
             Write_Id (Defining_Identifier (Node));
             Write_Discr_Specs (Node);
+
             if Present (Task_Definition (Node)) then
                Write_Str (" is");
                Sprint_Node (Task_Definition (Node));
@@ -2493,10 +2600,17 @@ package body Sprint is
             else
                if First_Name (Node) or else not Dump_Original_Only then
 
-                  --  Ada0Y (AI-50217): Print limited with_clauses
+                  --  Ada 2005 (AI-50217): Print limited with_clauses
 
-                  if Limited_Present (Node) then
+                  if Private_Present (Node) and Limited_Present (Node) then
+                     Write_Indent_Str ("limited private with ");
+
+                  elsif Private_Present (Node) then
+                     Write_Indent_Str ("private with ");
+
+                  elsif Limited_Present (Node) then
                      Write_Indent_Str ("limited with ");
+
                   else
                      Write_Indent_Str ("with ");
                   end if;
@@ -2703,13 +2817,13 @@ package body Sprint is
       Write_Str ("""]");
    end Write_Condition_And_Reason;
 
-   ------------------------
-   --  Write_Discr_Specs --
-   ------------------------
+   -----------------------
+   -- Write_Discr_Specs --
+   -----------------------
 
    procedure Write_Discr_Specs (N : Node_Id) is
-      Specs  : List_Id;
-      Spec   : Node_Id;
+      Specs : List_Id;
+      Spec  : Node_Id;
 
    begin
       Specs := Discriminant_Specifications (N);