Skip to content

R
riscv-gcc-1
Commit 78cef47f by Arnaud Charlet
Options

[multiple changes] 

2015-10-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Analyze_Loop_Statement): Attach generated loop
	identifier to the tree, because it may be the root of a tree
	traversal in Pop_Scope when freeze actions are pending.

2015-10-20  Steve Baird  <baird@adacore.com>

	* pprint.ads (Expression_Image) Add new generic formal flag
	Hide_Parameter_Blocks.
	* pprint.adb (Expression_Image) If new flag is set, then display
	dereferences of parameter block components accordingly.

From-SVN: r229068
parent e5f2c03c
Showing with 209 additions and 110 deletions
gcc/ada/ChangeLog
2015-10-20 Ed Schonberg <schonberg@adacore.com> 2015-10-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Loop_Statement): Attach generated loop
identifier to the tree, because it may be the root of a tree
traversal in Pop_Scope when freeze actions are pending.
2015-10-20 Steve Baird <baird@adacore.com>
* pprint.ads (Expression_Image) Add new generic formal flag
Hide_Parameter_Blocks.
* pprint.adb (Expression_Image) If new flag is set, then display
dereferences of parameter block components accordingly.
2015-10-20 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb: Code clean up. * sem_prag.adb: Code clean up.
2015-10-20 Hristian Kirtchev <kirtchev@adacore.com> 2015-10-20 Hristian Kirtchev <kirtchev@adacore.com>
......
gcc/ada/pprint.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2008-2014, Free Software Foundation, Inc. -- -- Copyright (C) 2008-2015, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -43,13 +43,16 @@ package body Pprint is ...@@ -43,13 +43,16 @@ package body Pprint is
-- Expression_Image -- -- Expression_Image --
---------------------- ----------------------
function Expression_Image (Expr : Node_Id; Default : String) function Expression_Image
return String is (Expr : Node_Id;
Left : Node_Id := Original_Node (Expr); Default : String) return String
Right : Node_Id := Original_Node (Expr); is
From_Source : constant Boolean := From_Source : constant Boolean :=
Comes_From_Source (Expr) and then not Opt.Debug_Generated_Code; Comes_From_Source (Expr)
and then not Opt.Debug_Generated_Code;
Append_Paren : Boolean := False; Append_Paren : Boolean := False;
Left : Node_Id := Original_Node (Expr);
Right : Node_Id := Original_Node (Expr);
function Expr_Name function Expr_Name
(Expr : Node_Id; (Expr : Node_Id;
...@@ -76,6 +79,10 @@ package body Pprint is ...@@ -76,6 +79,10 @@ package body Pprint is
Add_Paren : Boolean := True) return String; Add_Paren : Boolean := True) return String;
-- Return a string corresponding to List -- Return a string corresponding to List
---------------
-- List_Name --
---------------
function List_Name function List_Name
(List : Node_Id; (List : Node_Id;
Add_Space : Boolean := True; Add_Space : Boolean := True;
...@@ -87,6 +94,7 @@ package body Pprint is ...@@ -87,6 +94,7 @@ package body Pprint is
Add_Space : Boolean := True; Add_Space : Boolean := True;
Add_Paren : Boolean := True; Add_Paren : Boolean := True;
Num : Natural := 1) return String; Num : Natural := 1) return String;
-- ??? what does this do
------------------------ ------------------------
-- Internal_List_Name -- -- Internal_List_Name --
...@@ -100,6 +108,7 @@ package body Pprint is ...@@ -100,6 +108,7 @@ package body Pprint is
Num : Natural := 1) return String Num : Natural := 1) return String
is is
function Prepend (S : String) return String; function Prepend (S : String) return String;
-- ??? what does this do
------------- -------------
-- Prepend -- -- Prepend --
...@@ -137,20 +146,22 @@ package body Pprint is ...@@ -137,20 +146,22 @@ package body Pprint is
end if; end if;
end if; end if;
-- ??? the Internal_List_Name calls can be factored out
if First then if First then
return Prepend return Prepend (Expr_Name (List)
(Expr_Name (List) & Internal_List_Name
& Internal_List_Name (Next (List), (List => Next (List),
First => False, First => False,
Add_Paren => Add_Paren, Add_Paren => Add_Paren,
Num => Num + 1)); Num => Num + 1));
else else
return ", " & Expr_Name (List) & return ", " & Expr_Name (List)
Internal_List_Name & Internal_List_Name
(Next (List), (List => Next (List),
First => False, First => False,
Add_Paren => Add_Paren, Add_Paren => Add_Paren,
Num => Num + 1); Num => Num + 1);
end if; end if;
end Internal_List_Name; end Internal_List_Name;
...@@ -164,10 +175,13 @@ package body Pprint is ...@@ -164,10 +175,13 @@ package body Pprint is
end if; end if;
List_Name_Count := List_Name_Count + 1; List_Name_Count := List_Name_Count + 1;
declare declare
Result : constant String := Result : constant String :=
Internal_List_Name Internal_List_Name
(List, Add_Space => Add_Space, Add_Paren => Add_Paren); (List => List,
Add_Space => Add_Space,
Add_Paren => Add_Paren);
begin begin
List_Name_Count := List_Name_Count - 1; List_Name_Count := List_Name_Count - 1;
return Result; return Result;
...@@ -197,14 +211,14 @@ package body Pprint is ...@@ -197,14 +211,14 @@ package body Pprint is
when N_Character_Literal => when N_Character_Literal =>
declare declare
Char : constant Int := Char : constant Int :=
UI_To_Int (Char_Literal_Value (Expr)); UI_To_Int (Char_Literal_Value (Expr));
begin begin
if Char in 32 .. 127 then if Char in 32 .. 127 then
return "'" & Character'Val (Char) & "'"; return "'" & Character'Val (Char) & "'";
else else
UI_Image (Char_Literal_Value (Expr)); UI_Image (Char_Literal_Value (Expr));
return "'\" & UI_Image_Buffer (1 .. UI_Image_Length) return
& "'"; "'\" & UI_Image_Buffer (1 .. UI_Image_Length) & "'";
end if; end if;
end; end;
...@@ -223,8 +237,10 @@ package body Pprint is ...@@ -223,8 +237,10 @@ package body Pprint is
when N_Aggregate => when N_Aggregate =>
if Present (Sinfo.Expressions (Expr)) then if Present (Sinfo.Expressions (Expr)) then
return List_Name return
(First (Sinfo.Expressions (Expr)), Add_Space => False); List_Name
(List => First (Sinfo.Expressions (Expr)),
Add_Space => False);
-- Do not return empty string for (others => <>) aggregate -- Do not return empty string for (others => <>) aggregate
-- of a componentless record type. At least one caller (the -- of a componentless record type. At least one caller (the
...@@ -237,27 +253,30 @@ package body Pprint is ...@@ -237,27 +253,30 @@ package body Pprint is
return ("(null record)"); return ("(null record)");
else else
return List_Name return
(First (Component_Associations (Expr)), List_Name
Add_Space => False, Add_Paren => False); (List => First (Component_Associations (Expr)),
Add_Space => False,
Add_Paren => False);
end if; end if;
when N_Extension_Aggregate => when N_Extension_Aggregate =>
return "(" & Expr_Name (Ancestor_Part (Expr)) & return "(" & Expr_Name (Ancestor_Part (Expr)) & " with "
" with " & & List_Name
List_Name (First (Sinfo.Expressions (Expr)), (List => First (Sinfo.Expressions (Expr)),
Add_Space => False, Add_Paren => False) & Add_Space => False,
")"; Add_Paren => False) & ")";
when N_Attribute_Reference => when N_Attribute_Reference =>
if Take_Prefix then if Take_Prefix then
declare declare
Str : constant String := Expr_Name (Prefix (Expr))
& "'" & Get_Name_String (Attribute_Name (Expr));
Id : constant Attribute_Id := Id : constant Attribute_Id :=
Get_Attribute_Id (Attribute_Name (Expr)); Get_Attribute_Id (Attribute_Name (Expr));
Ranges : List_Id; Str : constant String :=
Expr_Name (Prefix (Expr)) & "'"
& Get_Name_String (Attribute_Name (Expr));
N : Node_Id; N : Node_Id;
Ranges : List_Id;
begin begin
if (Id = Attribute_First or else Id = Attribute_Last) if (Id = Attribute_First or else Id = Attribute_Last)
...@@ -271,22 +290,26 @@ package body Pprint is ...@@ -271,22 +290,26 @@ package body Pprint is
end if; end if;
if Nkind (N) = N_Subtype_Declaration then if Nkind (N) = N_Subtype_Declaration then
Ranges := Constraints (Constraint Ranges :=
(Subtype_Indication (N))); Constraints
(Constraint (Subtype_Indication (N)));
if List_Length (Ranges) = 1 if List_Length (Ranges) = 1
and then Nkind_In and then
(First (Ranges), Nkind_In
N_Range, (First (Ranges),
N_Real_Range_Specification, N_Range,
N_Signed_Integer_Type_Definition) N_Real_Range_Specification,
N_Signed_Integer_Type_Definition)
then then
if Id = Attribute_First then if Id = Attribute_First then
return Expression_Image return
(Low_Bound (First (Ranges)), Str); Expression_Image
(Low_Bound (First (Ranges)), Str);
else else
return Expression_Image return
(High_Bound (First (Ranges)), Str); Expression_Image
(High_Bound (First (Ranges)), Str);
end if; end if;
end if; end if;
end if; end if;
...@@ -300,7 +323,18 @@ package body Pprint is ...@@ -300,7 +323,18 @@ package body Pprint is
end if; end if;
when N_Explicit_Dereference => when N_Explicit_Dereference =>
if Take_Prefix then
-- Return "Foo" instead of "Parameter_Block.Foo.all"
if Hide_Parameter_Blocks
and then Nkind (Prefix (Expr)) = N_Selected_Component
and then Present (Etype (Prefix (Expr)))
and then Is_Access_Type (Etype (Prefix (Expr)))
and then Is_Param_Block_Component_Type (Etype (Prefix (Expr)))
then
return Expr_Name (Selector_Name (Prefix (Expr)));
elsif Take_Prefix then
return Expr_Name (Prefix (Expr)) & ".all"; return Expr_Name (Prefix (Expr)) & ".all";
else else
return ".all"; return ".all";
...@@ -308,31 +342,36 @@ package body Pprint is ...@@ -308,31 +342,36 @@ package body Pprint is
when N_Expanded_Name | N_Selected_Component => when N_Expanded_Name | N_Selected_Component =>
if Take_Prefix then if Take_Prefix then
return Expr_Name (Prefix (Expr)) return
& "." & Expr_Name (Selector_Name (Expr)); Expr_Name (Prefix (Expr)) & "." &
Expr_Name (Selector_Name (Expr));
else else
return "." & Expr_Name (Selector_Name (Expr)); return "." & Expr_Name (Selector_Name (Expr));
end if; end if;
when N_Component_Association => when N_Component_Association =>
return "(" return "("
& List_Name (First (Choices (Expr)), & List_Name
Add_Space => False, Add_Paren => False) (List => First (Choices (Expr)),
Add_Space => False,
Add_Paren => False)
& " => " & Expr_Name (Expression (Expr)) & ")"; & " => " & Expr_Name (Expression (Expr)) & ")";
when N_If_Expression => when N_If_Expression =>
declare declare
N : constant Node_Id := First (Sinfo.Expressions (Expr)); N : constant Node_Id := First (Sinfo.Expressions (Expr));
begin begin
return "if " & Expr_Name (N) & " then " & return
Expr_Name (Next (N)) & " else " & "if " & Expr_Name (N) & " then "
Expr_Name (Next (Next (N))); & Expr_Name (Next (N)) & " else "
& Expr_Name (Next (Next (N)));
end; end;
when N_Qualified_Expression => when N_Qualified_Expression =>
declare declare
Mark : constant String := Mark : constant String :=
Expr_Name (Subtype_Mark (Expr), Expand_Type => False); Expr_Name
(Subtype_Mark (Expr), Expand_Type => False);
Str : constant String := Expr_Name (Expression (Expr)); Str : constant String := Expr_Name (Expression (Expr));
begin begin
if Str (Str'First) = '(' and then Str (Str'Last) = ')' then if Str (Str'First) = '(' and then Str (Str'Last) = ')' then
...@@ -347,118 +386,145 @@ package body Pprint is ...@@ -347,118 +386,145 @@ package body Pprint is
when N_Raise_Constraint_Error => when N_Raise_Constraint_Error =>
if Present (Condition (Expr)) then if Present (Condition (Expr)) then
return "[constraint_error when " & return
Expr_Name (Condition (Expr)) & "]"; "[constraint_error when "
& Expr_Name (Condition (Expr)) & "]";
else else
return "[constraint_error]"; return "[constraint_error]";
end if; end if;
when N_Raise_Program_Error => when N_Raise_Program_Error =>
if Present (Condition (Expr)) then if Present (Condition (Expr)) then
return "[program_error when " & return
Expr_Name (Condition (Expr)) & "]"; "[program_error when "
& Expr_Name (Condition (Expr)) & "]";
else else
return "[program_error]"; return "[program_error]";
end if; end if;
when N_Range => when N_Range =>
return Expr_Name (Low_Bound (Expr)) & ".." & return
Expr_Name (Low_Bound (Expr)) & ".." &
Expr_Name (High_Bound (Expr)); Expr_Name (High_Bound (Expr));
when N_Slice => when N_Slice =>
return Expr_Name (Prefix (Expr)) & " (" & return
Expr_Name (Prefix (Expr)) & " (" &
Expr_Name (Discrete_Range (Expr)) & ")"; Expr_Name (Discrete_Range (Expr)) & ")";
when N_And_Then => when N_And_Then =>
return Expr_Name (Left_Opnd (Expr)) & " and then " & return
Expr_Name (Left_Opnd (Expr)) & " and then " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_In => when N_In =>
return Expr_Name (Left_Opnd (Expr)) & " in " & return
Expr_Name (Left_Opnd (Expr)) & " in " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Not_In => when N_Not_In =>
return Expr_Name (Left_Opnd (Expr)) & " not in " & return
Expr_Name (Left_Opnd (Expr)) & " not in " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Or_Else => when N_Or_Else =>
return Expr_Name (Left_Opnd (Expr)) & " or else " & return
Expr_Name (Left_Opnd (Expr)) & " or else " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_And => when N_Op_And =>
return Expr_Name (Left_Opnd (Expr)) & " and " & return
Expr_Name (Left_Opnd (Expr)) & " and " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Or => when N_Op_Or =>
return Expr_Name (Left_Opnd (Expr)) & " or " & return
Expr_Name (Left_Opnd (Expr)) & " or " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Xor => when N_Op_Xor =>
return Expr_Name (Left_Opnd (Expr)) & " xor " & return
Expr_Name (Left_Opnd (Expr)) & " xor " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Eq => when N_Op_Eq =>
return Expr_Name (Left_Opnd (Expr)) & " = " & return
Expr_Name (Left_Opnd (Expr)) & " = " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Ne => when N_Op_Ne =>
return Expr_Name (Left_Opnd (Expr)) & " /= " & return
Expr_Name (Left_Opnd (Expr)) & " /= " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Lt => when N_Op_Lt =>
return Expr_Name (Left_Opnd (Expr)) & " < " & return
Expr_Name (Left_Opnd (Expr)) & " < " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Le => when N_Op_Le =>
return Expr_Name (Left_Opnd (Expr)) & " <= " & return
Expr_Name (Left_Opnd (Expr)) & " <= " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Gt => when N_Op_Gt =>
return Expr_Name (Left_Opnd (Expr)) & " > " & return
Expr_Name (Left_Opnd (Expr)) & " > " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Ge => when N_Op_Ge =>
return Expr_Name (Left_Opnd (Expr)) & " >= " & return
Expr_Name (Left_Opnd (Expr)) & " >= " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Add => when N_Op_Add =>
return Expr_Name (Left_Opnd (Expr)) & " + " & return
Expr_Name (Left_Opnd (Expr)) & " + " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Subtract => when N_Op_Subtract =>
return Expr_Name (Left_Opnd (Expr)) & " - " & return
Expr_Name (Left_Opnd (Expr)) & " - " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Multiply => when N_Op_Multiply =>
return Expr_Name (Left_Opnd (Expr)) & " * " & return
Expr_Name (Left_Opnd (Expr)) & " * " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Divide => when N_Op_Divide =>
return Expr_Name (Left_Opnd (Expr)) & " / " & return
Expr_Name (Left_Opnd (Expr)) & " / " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Mod => when N_Op_Mod =>
return Expr_Name (Left_Opnd (Expr)) & " mod " & return
Expr_Name (Left_Opnd (Expr)) & " mod " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Rem => when N_Op_Rem =>
return Expr_Name (Left_Opnd (Expr)) & " rem " & return
Expr_Name (Left_Opnd (Expr)) & " rem " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Expon => when N_Op_Expon =>
return Expr_Name (Left_Opnd (Expr)) & " ** " & return
Expr_Name (Left_Opnd (Expr)) & " ** " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Shift_Left => when N_Op_Shift_Left =>
return Expr_Name (Left_Opnd (Expr)) & " << " & return
Expr_Name (Left_Opnd (Expr)) & " << " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Shift_Right | N_Op_Shift_Right_Arithmetic => when N_Op_Shift_Right | N_Op_Shift_Right_Arithmetic =>
return Expr_Name (Left_Opnd (Expr)) & " >> " & return
Expr_Name (Left_Opnd (Expr)) & " >> " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Concat => when N_Op_Concat =>
return Expr_Name (Left_Opnd (Expr)) & " & " & return
Expr_Name (Left_Opnd (Expr)) & " & " &
Expr_Name (Right_Opnd (Expr)); Expr_Name (Right_Opnd (Expr));
when N_Op_Plus => when N_Op_Plus =>
...@@ -485,8 +551,9 @@ package body Pprint is ...@@ -485,8 +551,9 @@ package body Pprint is
when N_Indexed_Component => when N_Indexed_Component =>
if Take_Prefix then if Take_Prefix then
return Expr_Name (Prefix (Expr)) & return
List_Name (First (Sinfo.Expressions (Expr))); Expr_Name (Prefix (Expr))
& List_Name (First (Sinfo.Expressions (Expr)));
else else
return List_Name (First (Sinfo.Expressions (Expr))); return List_Name (First (Sinfo.Expressions (Expr)));
end if; end if;
...@@ -498,12 +565,15 @@ package body Pprint is ...@@ -498,12 +565,15 @@ package body Pprint is
-- parentheses around function call to mark it specially. -- parentheses around function call to mark it specially.
if Default = "" then if Default = "" then
return '(' & Expr_Name (Name (Expr)) & return '('
List_Name (First (Sinfo.Parameter_Associations (Expr))) & & Expr_Name (Name (Expr))
')'; & List_Name (First (Sinfo.Parameter_Associations (Expr)))
& ')';
else else
return Expr_Name (Name (Expr)) & return
List_Name (First (Sinfo.Parameter_Associations (Expr))); Expr_Name (Name (Expr))
& List_Name
(First (Sinfo.Parameter_Associations (Expr)));
end if; end if;
when N_Null => when N_Null =>
...@@ -538,18 +608,24 @@ package body Pprint is ...@@ -538,18 +608,24 @@ package body Pprint is
loop loop
case Nkind (Left) is case Nkind (Left) is
when N_Binary_Op | N_Membership_Test | when N_And_Then |
N_And_Then | N_Or_Else => N_Binary_Op |
N_Membership_Test |
N_Or_Else =>
Left := Original_Node (Left_Opnd (Left)); Left := Original_Node (Left_Opnd (Left));
when N_Attribute_Reference | N_Expanded_Name | when N_Attribute_Reference |
N_Explicit_Dereference | N_Indexed_Component | N_Expanded_Name |
N_Reference | N_Selected_Component | N_Explicit_Dereference |
N_Slice => N_Indexed_Component |
N_Reference |
N_Selected_Component |
N_Slice =>
Left := Original_Node (Prefix (Left)); Left := Original_Node (Prefix (Left));
when N_Designator | N_Defining_Program_Unit_Name | when N_Defining_Program_Unit_Name |
N_Function_Call => N_Designator |
N_Function_Call =>
Left := Original_Node (Name (Left)); Left := Original_Node (Name (Left));
when N_Range => when N_Range =>
...@@ -567,11 +643,14 @@ package body Pprint is ...@@ -567,11 +643,14 @@ package body Pprint is
loop loop
case Nkind (Right) is case Nkind (Right) is
when N_Op | N_Membership_Test | when N_And_Then |
N_And_Then | N_Or_Else => N_Membership_Test |
N_Op |
N_Or_Else =>
Right := Original_Node (Right_Opnd (Right)); Right := Original_Node (Right_Opnd (Right));
when N_Selected_Component | N_Expanded_Name => when N_Expanded_Name |
N_Selected_Component =>
Right := Original_Node (Selector_Name (Right)); Right := Original_Node (Selector_Name (Right));
when N_Designator => when N_Designator =>
...@@ -634,11 +713,11 @@ package body Pprint is ...@@ -634,11 +713,11 @@ package body Pprint is
end loop; end loop;
declare declare
Scn : Source_Ptr := Original_Location (Sloc (Left));
Src : constant Source_Buffer_Ptr :=
Source_Text (Get_Source_File_Index (Scn));
End_Sloc : constant Source_Ptr := End_Sloc : constant Source_Ptr :=
Original_Location (Sloc (Right)); Original_Location (Sloc (Right));
Src : constant Source_Buffer_Ptr :=
Source_Text (Get_Source_File_Index (Scn));
Scn : Source_Ptr := Original_Location (Sloc (Left));
begin begin
if Scn > End_Sloc then if Scn > End_Sloc then
...@@ -647,9 +726,9 @@ package body Pprint is ...@@ -647,9 +726,9 @@ package body Pprint is
declare declare
Buffer : String (1 .. Natural (End_Sloc - Scn)); Buffer : String (1 .. Natural (End_Sloc - Scn));
Index : Natural := 0;
Skipping_Comment : Boolean := False; Skipping_Comment : Boolean := False;
Underscore : Boolean := False; Underscore : Boolean := False;
Index : Natural := 0;
begin begin
if Right /= Expr then if Right /= Expr then
......
gcc/ada/pprint.ads
...@@ -46,6 +46,10 @@ package Pprint is ...@@ -46,6 +46,10 @@ package Pprint is
-- nodes -- nodes
-- ??? Expand_Type argument should be removed -- ??? Expand_Type argument should be removed
Hide_Parameter_Blocks : Boolean := False;
-- If true, then "Parameter_Block.Field_Name.all" is
-- instead displayed as "Field_Name".
function Expression_Image function Expression_Image
(Expr : Node_Id; (Expr : Node_Id;
Default : String) return String; Default : String) return String;
......
gcc/ada/sem_ch5.adb
...@@ -3217,12 +3217,15 @@ package body Sem_Ch5 is ...@@ -3217,12 +3217,15 @@ package body Sem_Ch5 is
-- Case of no identifier present. Create one and attach it to the -- Case of no identifier present. Create one and attach it to the
-- loop statement for use as a scope and as a reference for later -- loop statement for use as a scope and as a reference for later
-- expansions. Indicate that the label does not come from source. -- expansions. Indicate that the label does not come from source,
-- and attach it to the loop statement so it is part of the tree,
-- even without a full declaration.
else else
Ent := New_Internal_Entity (E_Loop, Current_Scope, Loc, 'L'); Ent := New_Internal_Entity (E_Loop, Current_Scope, Loc, 'L');
Set_Etype (Ent, Standard_Void_Type); Set_Etype (Ent, Standard_Void_Type);
Set_Identifier (N, New_Occurrence_Of (Ent, Loc)); Set_Identifier (N, New_Occurrence_Of (Ent, Loc));
Set_Parent (Ent, N);
Set_Has_Created_Identifier (N); Set_Has_Created_Identifier (N);
end if; end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment