Skip to content

R
riscv-gcc-1
Commit ef952fd5 by Hristian Kirtchev Committed by Arnaud Charlet
Options

exp_util.adb, [...]: Minor reformatting. 

2017-04-28  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb, g-dyntab.adb, par-ch4.adb, sem_util.adb, sem_attr.adb,
	gnat1drv.adb, exp_disp.adb, namet.adb, alloc.ads: Minor reformatting.

From-SVN: r247383
parent dc99d241
Showing with 125 additions and 103 deletions
gcc/ada/ChangeLog
2017-04-28 Hristian Kirtchev <kirtchev@adacore.com>
* exp_util.adb, g-dyntab.adb, par-ch4.adb, sem_util.adb, sem_attr.adb,
gnat1drv.adb, exp_disp.adb, namet.adb, alloc.ads: Minor reformatting.
2017-04-28 Gary Dismukes <dismukes@adacore.com>
* exp_util.adb: Minor reformatting.
......
gcc/ada/alloc.ads
......@@ -43,122 +43,122 @@ package Alloc is
-- The comment shows the unit in which the table is defined
All_Interp_Initial : constant := 1_000; -- Sem_Type
All_Interp_Initial : constant := 1_000; -- Sem_Type
All_Interp_Increment : constant := 100;
Branches_Initial : constant := 1_000; -- Sem_Warn
Branches_Initial : constant := 1_000; -- Sem_Warn
Branches_Increment : constant := 100;
Conditionals_Initial : constant := 1_000; -- Sem_Warn
Conditionals_Initial : constant := 1_000; -- Sem_Warn
Conditionals_Increment : constant := 100;
Conditional_Stack_Initial : constant := 50; -- Sem_Warn
Conditional_Stack_Initial : constant := 50; -- Sem_Warn
Conditional_Stack_Increment : constant := 100;
Elists_Initial : constant := 200; -- Elists
Elists_Initial : constant := 200; -- Elists
Elists_Increment : constant := 100;
Elmts_Initial : constant := 1_200; -- Elists
Elmts_Initial : constant := 1_200; -- Elists
Elmts_Increment : constant := 100;
File_Name_Chars_Initial : constant := 10_000; -- Osint
File_Name_Chars_Initial : constant := 10_000; -- Osint
File_Name_Chars_Increment : constant := 100;
In_Out_Warnings_Initial : constant := 100; -- Sem_Warn
In_Out_Warnings_Initial : constant := 100; -- Sem_Warn
In_Out_Warnings_Increment : constant := 100;
Ignored_Ghost_Units_Initial : constant := 20; -- Sem_Util
Ignored_Ghost_Units_Initial : constant := 20; -- Sem_Util
Ignored_Ghost_Units_Increment : constant := 50;
Inlined_Initial : constant := 100; -- Inline
Inlined_Initial : constant := 100; -- Inline
Inlined_Increment : constant := 100;
Inlined_Bodies_Initial : constant := 50; -- Inline
Inlined_Bodies_Initial : constant := 50; -- Inline
Inlined_Bodies_Increment : constant := 200;
Interp_Map_Initial : constant := 200; -- Sem_Type
Interp_Map_Initial : constant := 200; -- Sem_Type
Interp_Map_Increment : constant := 100;
Lines_Initial : constant := 500; -- Sinput
Lines_Initial : constant := 500; -- Sinput
Lines_Increment : constant := 150;
Linker_Option_Lines_Initial : constant := 5; -- Lib
Linker_Option_Lines_Initial : constant := 5; -- Lib
Linker_Option_Lines_Increment : constant := 200;
Lists_Initial : constant := 4_000; -- Nlists
Lists_Initial : constant := 4_000; -- Nlists
Lists_Increment : constant := 200;
Load_Stack_Initial : constant := 10; -- Lib
Load_Stack_Initial : constant := 10; -- Lib
Load_Stack_Increment : constant := 100;
Name_Chars_Initial : constant := 50_000; -- Namet
Name_Chars_Initial : constant := 50_000; -- Namet
Name_Chars_Increment : constant := 100;
Name_Qualify_Units_Initial : constant := 200; -- Exp_Dbug
Name_Qualify_Units_Initial : constant := 200; -- Exp_Dbug
Name_Qualify_Units_Increment : constant := 300;
Names_Initial : constant := 6_000; -- Namet
Names_Initial : constant := 6_000; -- Namet
Names_Increment : constant := 100;
Nodes_Initial : constant := 5_000_000; -- Atree
Nodes_Increment : constant := 100;
Nodes_Release_Threshold : constant := 100_000;
Notes_Initial : constant := 100; -- Lib
Notes_Initial : constant := 100; -- Lib
Notes_Increment : constant := 200;
Obsolescent_Warnings_Initial : constant := 50; -- Sem_Prag
Obsolescent_Warnings_Initial : constant := 50; -- Sem_Prag
Obsolescent_Warnings_Increment : constant := 200;
Pending_Instantiations_Initial : constant := 10; -- Inline
Pending_Instantiations_Initial : constant := 10; -- Inline
Pending_Instantiations_Increment : constant := 100;
Rep_Table_Initial : constant := 1000; -- Repinfo
Rep_Table_Initial : constant := 1000; -- Repinfo
Rep_Table_Increment : constant := 200;
Scope_Stack_Initial : constant := 10; -- Sem
Scope_Stack_Initial : constant := 10; -- Sem
Scope_Stack_Increment : constant := 200;
SFN_Table_Initial : constant := 10; -- Fname
SFN_Table_Initial : constant := 10; -- Fname
SFN_Table_Increment : constant := 200;
Source_File_Initial : constant := 10; -- Sinput
Source_File_Initial : constant := 10; -- Sinput
Source_File_Increment : constant := 200;
String_Chars_Initial : constant := 2_500; -- Stringt
String_Chars_Initial : constant := 2_500; -- Stringt
String_Chars_Increment : constant := 150;
Strings_Initial : constant := 5_00; -- Stringt
Strings_Initial : constant := 5_00; -- Stringt
Strings_Increment : constant := 150;
Successors_Initial : constant := 2_00; -- Inline
Successors_Initial : constant := 2_00; -- Inline
Successors_Increment : constant := 100;
Udigits_Initial : constant := 10_000; -- Uintp
Udigits_Initial : constant := 10_000; -- Uintp
Udigits_Increment : constant := 100;
Uints_Initial : constant := 5_000; -- Uintp
Uints_Initial : constant := 5_000; -- Uintp
Uints_Increment : constant := 100;
Units_Initial : constant := 30; -- Lib
Units_Initial : constant := 30; -- Lib
Units_Increment : constant := 100;
Ureals_Initial : constant := 200; -- Urealp
Ureals_Initial : constant := 200; -- Urealp
Ureals_Increment : constant := 100;
Unreferenced_Entities_Initial : constant := 1_000; -- Sem_Warn
Unreferenced_Entities_Initial : constant := 1_000; -- Sem_Warn
Unreferenced_Entities_Increment : constant := 100;
Warnings_Off_Pragmas_Initial : constant := 500; -- Sem_Warn
Warnings_Off_Pragmas_Initial : constant := 500; -- Sem_Warn
Warnings_Off_Pragmas_Increment : constant := 100;
With_List_Initial : constant := 10; -- Features
With_List_Initial : constant := 10; -- Features
With_List_Increment : constant := 300;
Xrefs_Initial : constant := 5_000; -- Cross-refs
Xrefs_Initial : constant := 5_000; -- Cross-refs
Xrefs_Increment : constant := 300;
Drefs_Initial : constant := 5; -- Dereferences
Drefs_Initial : constant := 5; -- Dereferences
Drefs_Increment : constant := 1_000;
end Alloc;
gcc/ada/exp_disp.adb
......@@ -651,8 +651,8 @@ package body Exp_Disp is
Controlling_Tag : Node_Id;
procedure Build_Class_Wide_Check;
-- If the denoted subprogram has a class-wide precondition, generate
-- a check using that precondition before the dispatching call, because
-- If the denoted subprogram has a class-wide precondition, generate a
-- check using that precondition before the dispatching call, because
-- this is the only class-wide precondition that applies to the call.
function New_Value (From : Node_Id) return Node_Id;
......@@ -665,11 +665,6 @@ package body Exp_Disp is
----------------------------
procedure Build_Class_Wide_Check is
Prec : Node_Id;
Cond : Node_Id;
Msg : Node_Id;
Str_Loc : constant String := Build_Location_String (Loc);
function Replace_Formals (N : Node_Id) return Traverse_Result;
-- Replace occurrences of the formals of the subprogram by the
-- corresponding actuals in the call, given that this check is
......@@ -697,6 +692,7 @@ package body Exp_Disp is
Rewrite (N, New_Copy_Tree (A));
exit;
end if;
Next_Formal (F);
Next_Actual (A);
end loop;
......@@ -707,6 +703,17 @@ package body Exp_Disp is
end Replace_Formals;
procedure Update is new Traverse_Proc (Replace_Formals);
-- Local variables
Str_Loc : constant String := Build_Location_String (Loc);
Cond : Node_Id;
Msg : Node_Id;
Prec : Node_Id;
-- Start of processing for Build_Class_Wide_Check
begin
-- Locate class-wide precondition, if any
......@@ -727,11 +734,12 @@ package body Exp_Disp is
end if;
-- The expression for the precondition is analyzed within the
-- generated pragma. The message text is the last parameter
-- of the generated pragma, indicating source of precondition.
-- generated pragma. The message text is the last parameter of
-- the generated pragma, indicating source of precondition.
Cond := New_Copy_Tree
(Expression (First (Pragma_Argument_Associations (Prec))));
Cond :=
New_Copy_Tree
(Expression (First (Pragma_Argument_Associations (Prec))));
Update (Cond);
-- Build message indicating the failed precondition and the
......@@ -745,14 +753,13 @@ package body Exp_Disp is
Msg := Make_String_Literal (Loc, Name_Buffer (1 .. Name_Len));
Insert_Action (Call_Node,
Make_If_Statement (Loc,
Condition => Make_Op_Not (Loc, Cond),
Then_Statements => New_List (
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of
(RTE (RE_Raise_Assert_Failure), Loc),
Parameter_Associations => New_List (Msg)))));
Make_If_Statement (Loc,
Condition => Make_Op_Not (Loc, Cond),
Then_Statements => New_List (
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Raise_Assert_Failure), Loc),
Parameter_Associations => New_List (Msg)))));
end if;
end Build_Class_Wide_Check;
......
gcc/ada/exp_util.adb
......@@ -1114,8 +1114,8 @@ package body Exp_Util is
if Present (New_E) then
Rewrite (N, New_Occurrence_Of (New_E, Sloc (N)));
-- If the entity is an overridden primitive and we are not in
-- GNATprove mode, we must build a wrapper for the current
-- If the entity is an overridden primitive and we are not
-- in GNATprove mode, we must build a wrapper for the current
-- inherited operation. If the reference is the prefix of an
-- attribute such as 'Result (or others ???) there is no need
-- for a wrapper: the condition is just rewritten in terms of
......@@ -1123,7 +1123,7 @@ package body Exp_Util is
if Is_Subprogram (New_E)
and then Nkind (Parent (N)) /= N_Attribute_Reference
and then not GNATprove_Mode
and then not GNATprove_Mode
then
Needs_Wrapper := True;
end if;
......
gcc/ada/g-dyntab.adb
......@@ -71,9 +71,12 @@ package body GNAT.Dynamic_Tables is
procedure Append (T : in out Instance; New_Val : Table_Component_Type) is
pragma Assert (not T.Locked);
New_Last : constant Table_Last_Type := Last (T) + 1;
begin
if New_Last <= Last_Allocated (T) then
-- fast path
-- Fast path
T.P.Last := New_Last;
T.Table (New_Last) := New_Val;
......@@ -144,7 +147,7 @@ package body GNAT.Dynamic_Tables is
subtype Table_Length_Type is Table_Index_Type'Base
range 0 .. Table_Index_Type'Base'Last;
Old_Last_Allocated : constant Table_Last_Type := Last_Allocated (T);
Old_Last_Allocated : constant Table_Last_Type := Last_Allocated (T);
Old_Allocated_Length : constant Table_Length_Type :=
Old_Last_Allocated - First + 1;
......
gcc/ada/gnat1drv.adb
......@@ -116,6 +116,24 @@ procedure Gnat1drv is
----------------------------
procedure Adjust_Global_Switches is
procedure SPARK_Library_Warning (Kind : String);
-- Issue a warning in GNATprove mode if the run-time library does not
-- fully support IEEE-754 floating-point semantics.
---------------------------
-- SPARK_Library_Warning --
---------------------------
procedure SPARK_Library_Warning (Kind : String) is
begin
Write_Line
("warning: run-time library may be configured incorrectly");
Write_Line
("warning: (SPARK analysis requires support for " & Kind & ')');
end SPARK_Library_Warning;
-- Start of processing for Adjust_Global_Switches
begin
-- -gnatd.M enables Relaxed_RM_Semantics
......@@ -500,29 +518,15 @@ procedure Gnat1drv is
-- Detect that the runtime library support for floating-point numbers
-- may not be compatible with SPARK analysis of IEEE-754 floats.
declare
procedure SPARK_Library_Warning (Kind : String);
-- Issue a warning in GNATprove mode if the run-time library does
-- not fully support IEEE-754 floating-point semantics.
if Denorm_On_Target = False then
SPARK_Library_Warning ("float subnormals");
procedure SPARK_Library_Warning (Kind : String) is
begin
Write_Line
("warning: run-time library may be configured incorrectly");
Write_Line
("warning: (SPARK analysis requires support for " & Kind
& ')');
end SPARK_Library_Warning;
elsif Machine_Rounds_On_Target = False then
SPARK_Library_Warning ("float rounding");
begin
if Denorm_On_Target = False then
SPARK_Library_Warning ("float subnormals");
elsif Machine_Rounds_On_Target = False then
SPARK_Library_Warning ("float rounding");
elsif Signed_Zeros_On_Target = False then
SPARK_Library_Warning ("signed zeros");
end if;
end;
elsif Signed_Zeros_On_Target = False then
SPARK_Library_Warning ("signed zeros");
end if;
end if;
-- Set Configurable_Run_Time mode if system.ads flag set or if the
......
gcc/ada/namet.adb
......@@ -161,10 +161,11 @@ package body Namet is
procedure Append (Buf : in out Bounded_String; Id : Name_Id) is
pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
Index : constant Int := Name_Entries.Table (Id).Name_Chars_Index;
Len : constant Short := Name_Entries.Table (Id).Name_Len;
Index : constant Int := Name_Entries.Table (Id).Name_Chars_Index;
Len : constant Short := Name_Entries.Table (Id).Name_Len;
Chars : Name_Chars.Table_Type renames
Name_Chars.Table (Index + 1 .. Index + Int (Len));
Name_Chars.Table (Index + 1 .. Index + Int (Len));
begin
Append (Buf, String (Chars));
end Append;
......@@ -174,8 +175,8 @@ package body Namet is
--------------------
procedure Append_Decoded (Buf : in out Bounded_String; Id : Name_Id) is
C : Character;
P : Natural;
C : Character;
P : Natural;
Temp : Bounded_String;
begin
......
gcc/ada/par-ch4.adb
......@@ -589,7 +589,7 @@ package body Ch4 is
-- Special handling for 'Image in Ada 2012, where
-- the attribute can be parameterless and its value
-- can be the prefix of a slice. Rewrite name as a
-- a slice, Expr is its low bound.
-- slice, Expr is its low bound.
if Token = Tok_Dot_Dot
and then Attr_Name = Name_Image
......
gcc/ada/sem_attr.adb
......@@ -4032,11 +4032,11 @@ package body Sem_Attr is
when Attribute_Image =>
Check_SPARK_05_Restriction_On_Attribute;
-- AI12-00124-1 : The ARG has adopted the GNAT semantics of 'Img
-- for scalar types, so that the prefix can be an object and not
-- a type, and there is no need for an argument. Given this vote
-- of confidence from the ARG, simplest is to transform this new
-- usage of 'Image into a reference to 'Img.
-- AI12-00124-1 : The ARG has adopted the GNAT semantics of 'Img for
-- scalar types, so that the prefix can be an object and not a type,
-- and there is no need for an argument. Given the vote of confidence
-- from the ARG, simplest is to transform this new usage of 'Image
-- into a reference to 'Img.
if Ada_Version > Ada_2005
and then Is_Object_Reference (P)
......@@ -4048,19 +4048,20 @@ package body Sem_Attr is
Prefix => Relocate_Node (P),
Attribute_Name => Name_Img));
-- If the attribute reference includes expressions, the
-- only possible interpretation is as an indexing of the
-- parameterless version of 'Image, so rewrite it accordingly.
-- If the attribute reference includes expressions, the only
-- possible interpretation is as an indexing of the parameterless
-- version of 'Image, so rewrite it accordingly.
else
Rewrite (N,
Make_Indexed_Component (Loc,
Prefix =>
Make_Attribute_Reference (Loc,
Prefix => Relocate_Node (P),
Attribute_Name => Name_Img),
Expressions => Expressions (N)));
Make_Indexed_Component (Loc,
Prefix =>
Make_Attribute_Reference (Loc,
Prefix => Relocate_Node (P),
Attribute_Name => Name_Img),
Expressions => Expressions (N)));
end if;
Analyze (N);
return;
......
gcc/ada/sem_util.adb
......@@ -11251,6 +11251,7 @@ package body Sem_Util is
S := Current_Scope;
while Present (S) and then S /= Standard_Standard loop
if Is_Generic_Instance (S) then
-- A child instance is always compiled in the context of a parent
-- instance. Nevertheless, the actuals are not analyzed in an
-- instance context. We detect this case by examining the current
......
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