-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2002, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Dump_Generated_Only : Boolean;
-- Set True if the -gnatG (dump generated tree) debug flag is set
- -- or for Print_Generated_Code (-gnatG) or Dump_Gnerated_Code (-gnatD).
+ -- or for Print_Generated_Code (-gnatG) or Dump_Generated_Code (-gnatD).
Dump_Freeze_Null : Boolean;
-- Set True if freeze nodes and non-source null statements output
-- with a lower precedence than the operator (or equal precedence if
-- appearing as the right operand), then parentheses are required.
- Op_Prec : array (N_Subexpr) of Short_Short_Integer :=
+ Op_Prec : constant array (N_Subexpr) of Short_Short_Integer :=
(N_Op_And => 1,
N_Op_Or => 1,
N_Op_Xor => 1,
-- Write Condition and Reason codes of Raise_xxx_Error node
procedure Write_Discr_Specs (N : Node_Id);
- -- Output discriminant specification for node, which is any of the type
+ -- Ouput discriminant specification for node, which is any of the type
-- declarations that can have discriminants.
procedure Write_Ekind (E : Entity_Id);
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
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
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 =>
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
Set_Debug_Sloc;
Sprint_Bar_List (Choices (Node));
Write_Str (" => ");
- Sprint_Node (Expression (Node));
+
+ -- Ada 2005 (AI-287): Print the mbox if present
+
+ if Box_Present (Node) then
+ Write_Str_With_Col_Check ("<>");
+ else
+ Sprint_Node (Expression (Node));
+ end if;
when N_Component_Clause =>
Write_Indent;
Sprint_Node (Last_Bit (Node));
Write_Char (';');
- when N_Component_Declaration =>
- if Write_Indent_Identifiers_Sloc (Node) then
- Write_Str (" : ");
+ when N_Component_Definition =>
+ Set_Debug_Sloc;
+
+ -- Ada 2005 (AI-230): Access definition components
+ 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
+ Write_Str (" : ");
+ Sprint_Node (Component_Definition (Node));
+
if Present (Expression (Node)) then
Write_Str (" := ");
Sprint_Node (Expression (Node));
Sprint_Paren_Comma_List (Discrete_Subtype_Definitions (Node));
Write_Str (" of ");
- if Aliased_Present (Node) then
- Write_Str_With_Col_Check ("aliased ");
- end if;
-
- Sprint_Node (Subtype_Indication (Node));
+ Sprint_Node (Component_Definition (Node));
when N_Decimal_Fixed_Point_Definition =>
Write_Str_With_Col_Check_Sloc (" delta ");
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
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
Write_Char (';');
+ when N_Expanded_Name =>
+ Sprint_Node (Prefix (Node));
+ Write_Char_Sloc ('.');
+ Sprint_Node (Selector_Name (Node));
+
when N_Explicit_Dereference =>
Sprint_Node (Prefix (Node));
- Write_Char ('.');
+ Write_Char_Sloc ('.');
Write_Str_Sloc ("all");
when N_Extension_Aggregate =>
end if;
when N_Object_Declaration =>
+ Set_Debug_Sloc;
- -- Put extra blank line before and after if this is a handler
- -- record or a subprogram descriptor.
-
- declare
- Typ : constant Entity_Id := Etype (Defining_Identifier (Node));
- Exc : constant Boolean :=
- Is_RTE (Typ, RE_Handler_Record)
- or else
- Is_RTE (Typ, RE_Subprogram_Descriptor);
+ if Write_Indent_Identifiers (Node) then
+ Write_Str (" : ");
- begin
- if Exc then
- Write_Indent;
+ if Aliased_Present (Node) then
+ Write_Str_With_Col_Check ("aliased ");
end if;
- Set_Debug_Sloc;
-
- if Write_Indent_Identifiers (Node) then
- Write_Str (" : ");
-
- if Aliased_Present (Node) then
- Write_Str_With_Col_Check ("aliased ");
- end if;
+ if Constant_Present (Node) then
+ Write_Str_With_Col_Check ("constant ");
+ end if;
- if Constant_Present (Node) then
- Write_Str_With_Col_Check ("constant ");
- end if;
+ -- Ada 2005 (AI-231)
- Sprint_Node (Object_Definition (Node));
+ if Null_Exclusion_Present (Node) then
+ Write_Str_With_Col_Check ("not null ");
+ end if;
- if Present (Expression (Node)) then
- Write_Str (" := ");
- Sprint_Node (Expression (Node));
- end if;
+ Sprint_Node (Object_Definition (Node));
- Write_Char (';');
+ if Present (Expression (Node)) then
+ Write_Str (" := ");
+ Sprint_Node (Expression (Node));
end if;
- if Exc then
- Write_Indent;
- end if;
- end;
+ Write_Char (';');
+ end if;
when N_Object_Renaming_Declaration =>
Write_Indent;
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 (';');
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
Write_Char (';');
- when N_Selected_Component | N_Expanded_Name =>
+ when N_Selected_Component =>
Sprint_Node (Prefix (Node));
Write_Char_Sloc ('.');
Sprint_Node (Selector_Name (Node));
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 (';');
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));
end;
Write_Str (") of ");
-
- if Aliased_Present (Node) then
- Write_Str_With_Col_Check ("aliased ");
- end if;
-
- Sprint_Node (Subtype_Indication (Node));
+ Sprint_Node (Component_Definition (Node));
when N_Unused_At_Start | N_Unused_At_End =>
Write_Indent_Str ("***** Error, unused node encountered *****");
else
if First_Name (Node) or else not Dump_Original_Only then
- Write_Indent_Str ("with ");
+
+ -- Ada 2005 (AI-50217): Print limited with_clauses
+
+ 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;
+
else
Write_Str (", ");
end if;
end if;
when N_With_Type_Clause =>
-
Write_Indent_Str ("with type ");
Sprint_Node_Sloc (Name (Node));
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);
then
Write_Id (Entity (Parent (N)));
- -- For any other kind of node with an associated entity, output it.
+ -- For any other node with an associated entity, output it
elsif Nkind (N) in N_Has_Entity
- and then Present (Entity (N))
+ and then Present (Entity_Or_Associated_Node (N))
+ and then Nkind (Entity_Or_Associated_Node (N)) in N_Entity
then
Write_Id (Entity (N));
OSDN Git Service
