procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2011-08-05  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, gnatcmd.adb, switch-c.adb, exp_attr.adb, make.adb,
	bindgen.adb, einfo.adb, sem_ch12.adb, sem_attr.adb, a-fihema.adb,
	a-fihema.ads, sem_elab.adb, sem_elab.ads, aspects.adb, opt.ads,
	prj-conf.adb, sem_ch13.adb, s-ficobl.ads: Minor reformatting

2011-08-05  Bob Duff  <duff@adacore.com>

	* a-stunau.ads, g-spipat.adb: Update comments.

From-SVN: r177441
This commit is contained in:
Arnaud Charlet 2011-08-05 16:14:36 +02:00
parent 36f686f99b
commit bb3c784c7d
21 changed files with 103 additions and 82 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
gcc/ada/ChangeLog
View file

@ -1,3 +1,14 @@
2011-08-05 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, gnatcmd.adb, switch-c.adb, exp_attr.adb, make.adb,
bindgen.adb, einfo.adb, sem_ch12.adb, sem_attr.adb, a-fihema.adb,
a-fihema.ads, sem_elab.adb, sem_elab.ads, aspects.adb, opt.ads,
prj-conf.adb, sem_ch13.adb, s-ficobl.ads: Minor reformatting
2011-08-05 Bob Duff <duff@adacore.com>
* a-stunau.ads, g-spipat.adb: Update comments.
2011-08-05 Bob Duff <duff@adacore.com>
* a-fihema.ads: Minor comment fix.

27
gcc/ada/a-fihema.adb
View file

@ -41,7 +41,7 @@ with System.Storage_Pools; use System.Storage_Pools;
package body Ada.Finalization.Heap_Management is
Header_Size : constant Storage_Count := Node'Size / Storage_Unit;
Header_Size : constant Storage_Count := Node'Size / Storage_Unit;
-- Size of the header in bytes. Added to Storage_Size requested by
-- Allocate/Deallocate to determine the Storage_Size passed to the
-- underlying pool.
@ -149,6 +149,7 @@ package body Ada.Finalization.Heap_Management is
N.Prev := L;
Unlock_Task.all;
-- Note: no need to unlock in case of exceptions; the above code cannot
-- raise any.
end Attach;
@ -185,8 +186,7 @@ package body Ada.Finalization.Heap_Management is
N_Ptr : Node_Ptr;
begin
-- Move the address from the object to the beginning of the list
-- header.
-- Move address from the object to beginning of the list header
N_Addr := Addr - Header_Offset;
@ -221,8 +221,10 @@ package body Ada.Finalization.Heap_Management is
------------
procedure Detach (N : Node_Ptr) is
-- N must be attached to some list
pragma Assert (N.Next /= null and then N.Prev /= null);
-- It must be attached to some list
procedure Null_Out_Pointers;
-- Set Next/Prev pointer of N to null (for debugging)
@ -237,6 +239,8 @@ package body Ada.Finalization.Heap_Management is
N.Prev := null;
end Null_Out_Pointers;
-- Start of processing for Detach
begin
Lock_Task.all;
@ -247,9 +251,10 @@ package body Ada.Finalization.Heap_Management is
-- Note: no need to unlock in case of exceptions; the above code cannot
-- raise any.
pragma Debug (Null_Out_Pointers);
-- No need to null out the pointers, except that it makes pcol easier to
-- understand.
pragma Debug (Null_Out_Pointers);
end Detach;
--------------
@ -278,13 +283,14 @@ package body Ada.Finalization.Heap_Management is
-- to go away.
while Curr_Ptr /= Collection.Objects'Unchecked_Access loop
-- ??? Kludge: Don't do anything until the proper place to set
-- primitive Finalize_Address has been determined.
if Collection.Finalize_Address /= null then
declare
Object_Address : constant Address :=
Curr_Ptr.all'Address + Header_Offset;
Curr_Ptr.all'Address + Header_Offset;
-- Get address of object from address of header
begin
@ -330,8 +336,8 @@ package body Ada.Finalization.Heap_Management is
procedure pcol (Collection : Finalization_Collection) is
Head : constant Node_Ptr := Collection.Objects'Unrestricted_Access;
-- "Unrestricted", because we're evilly getting access-to-variable of a
-- constant! OK for debugging code.
-- "Unrestricted", because we are getting access-to-variable of a
-- constant! Normally worrisome, this is OK for debugging code.
Head_Seen : Boolean := False;
N_Ptr : Node_Ptr;
@ -348,6 +354,7 @@ package body Ada.Finalization.Heap_Management is
Put_Line (Address_Image (Collection'Address));
Put ("Base_Pool : ");
if Collection.Base_Pool = null then
Put_Line (" null");
else
@ -355,6 +362,7 @@ package body Ada.Finalization.Heap_Management is
end if;
Put ("Fin_Addr : ");
if Collection.Finalize_Address = null then
Put_Line ("null");
else
@ -384,7 +392,6 @@ package body Ada.Finalization.Heap_Management is
-- (dummy head) - present if dummy head
N_Ptr := Head;
while N_Ptr /= null loop -- Should never be null; we being defensive
Put_Line ("V");
@ -428,6 +435,7 @@ package body Ada.Finalization.Heap_Management is
end if;
Put ("| Prev: ");
if N_Ptr.Prev = null then
Put_Line ("null");
else
@ -435,6 +443,7 @@ package body Ada.Finalization.Heap_Management is
end if;
Put ("| Next: ");
if N_Ptr.Next = null then
Put_Line ("null");
else

15
gcc/ada/a-fihema.ads
View file

@ -92,8 +92,7 @@ package Ada.Finalization.Heap_Management is
overriding procedure Finalize
(Collection : in out Finalization_Collection);
-- Traverse the objects of Collection, invoking Finalize_Address on each of
-- them.
-- Traverse objects of Collection, invoking Finalize_Address on each one
overriding procedure Initialize
(Collection : in out Finalization_Collection);
@ -116,13 +115,13 @@ private
type Node_Ptr is access all Node;
pragma No_Strict_Aliasing (Node_Ptr);
type Node is record
-- This should really be limited, but we can see the full view of
-- Limited_Controlled, which is NOT limited. Note that default
-- initialization does not happen for this type (these pointers will not
-- be automatically set to null), because of the games we're playing
-- with address arithmetic.
-- The following record type should really be limited, but we can see the
-- full view of Limited_Controlled, which is NOT limited. Note that default
-- initialization does not happen for this type (the pointers will not be
-- automatically set to null), because of the games we're playing with
-- address arithmetic.
type Node is record
Prev : Node_Ptr;
Next : Node_Ptr;
end record;

8
gcc/ada/a-stunau.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
@ -68,12 +68,6 @@ package Ada.Strings.Unbounded.Aux is
-- referenced string returned by this call is always one, so the actual
-- string data is always accessible as S (1 .. L).
procedure Set_String (UP : out Unbounded_String; S : String)
renames Set_Unbounded_String;
-- This function is simply a renaming of the new Ada 2005 function as shown
-- above. It is provided for historical reasons, but should be removed at
-- this stage???
procedure Set_String (UP : in out Unbounded_String; S : String_Access);
pragma Inline (Set_String);
-- This version of Set_Unbounded_String takes a string access value, rather

11
gcc/ada/aspects.adb
View file

@ -42,12 +42,11 @@ package body Aspects is
-- Same as Set_Aspect_Specifications, but does not contain the assertion
-- that checks that N does not already have aspect specifications. This
-- subprogram is supposed to be used as a part of Tree_Read. When reading
-- the tree we first read nodes with their basic properties (as
-- Atree.Tree_Read), this includes reading the Has_Aspects flag for each
-- node, then we reed all the list tables and only after that we call
-- Tree_Read for Aspects. That is, when reading the tree, the list of
-- aspects is attached to the node that already has Has_Aspects flag set
-- ON
-- tree, first read nodes with their basic properties (as Atree.Tree_Read),
-- this includes reading the Has_Aspects flag for each node, then we reed
-- all the list tables and only after that we call Tree_Read for Aspects.
-- That is, when reading the tree, the list of aspects is attached to the
-- node that already has Has_Aspects flag set ON.
------------------------------------------
-- Hash Table for Aspect Specifications --

12
gcc/ada/bindgen.adb
View file

@ -929,6 +929,7 @@ package body Bindgen is
procedure Gen_CodePeer_Wrapper is
Callee_Name : constant String := "Ada_Main_Program";
begin
if ALIs.Table (ALIs.First).Main_Program = Proc then
WBI (" procedure " & CodePeer_Wrapper_Name & " is ");
@ -1472,6 +1473,7 @@ package body Bindgen is
procedure Gen_Main is
begin
if not No_Main_Subprogram then
-- To call the main program, we declare it using a pragma Import
-- Ada with the right link name.
@ -1488,7 +1490,6 @@ package body Bindgen is
if ALIs.Table (ALIs.First).Main_Program = Func then
WBI (" function Ada_Main_Program return Integer;");
else
WBI (" procedure Ada_Main_Program;");
end if;
@ -1584,8 +1585,8 @@ package body Bindgen is
end if;
if Bind_Main_Program
and then not Suppress_Standard_Library_On_Target
and then not CodePeer_Mode
and not Suppress_Standard_Library_On_Target
and not CodePeer_Mode
then
WBI (" SEH : aliased array (1 .. 2) of Integer;");
WBI ("");
@ -1603,9 +1604,8 @@ package body Bindgen is
-- this variable at any level of optimization.
if Bind_Main_Program and not CodePeer_Mode then
WBI
(" Ensure_Reference : aliased System.Address := " &
"Ada_Main_Program_Name'Address;");
WBI (" Ensure_Reference : aliased System.Address := " &
"Ada_Main_Program_Name'Address;");
WBI (" pragma Volatile (Ensure_Reference);");
WBI ("");
end if;

2
gcc/ada/einfo.adb
View file

@ -519,10 +519,10 @@ package body Einfo is
-- Is_Safe_To_Reevaluate Flag249
-- Has_Predicates Flag250
-- (Has_Implicit_Dereference) Flag251
-- Is_Processed_Transient Flag252
-- Is_Postcondition_Proc Flag253
-- (Has_Implicit_Dereference) Flag251
-- (unused) Flag254
-----------------------

10
gcc/ada/exp_attr.adb
View file

@ -678,13 +678,13 @@ package body Exp_Attr is
case Id is
-- Attributes related to Ada2012 iterators (Placeholder)
-- Attributes related to Ada2012 iterators (placeholder ???)
when Attribute_Constant_Indexing => null;
when Attribute_Default_Iterator => null;
when Attribute_Constant_Indexing => null;
when Attribute_Default_Iterator => null;
when Attribute_Implicit_Dereference => null;
when Attribute_Iterator_Element => null;
when Attribute_Variable_Indexing => null;
when Attribute_Iterator_Element => null;
when Attribute_Variable_Indexing => null;
------------
-- Access --

12
gcc/ada/g-spipat.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2010, AdaCore --
-- Copyright (C) 1998-2011, AdaCore --
-- --
-- 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- --
@ -3851,7 +3851,8 @@ package body GNAT.Spitbol.Patterns is
begin
if Node_OnM.Pcode = PC_Assign_OnM then
Set_String (Node_OnM.VP.all, Subject (Start .. Stop));
Set_Unbounded_String
(Node_OnM.VP.all, Subject (Start .. Stop));
elsif Node_OnM.Pcode = PC_Write_OnM then
Put_Line (Node_OnM.FP.all, Subject (Start .. Stop));
@ -4062,7 +4063,7 @@ package body GNAT.Spitbol.Patterns is
-- Assign immediate. This node performs the actual assignment
when PC_Assign_Imm =>
Set_String
Set_Unbounded_String
(Node.VP.all,
Subject (Stack (Stack_Base - 1).Cursor + 1 .. Cursor));
Pop_Region;
@ -5228,7 +5229,8 @@ package body GNAT.Spitbol.Patterns is
begin
if Node_OnM.Pcode = PC_Assign_OnM then
Set_String (Node_OnM.VP.all, Subject (Start .. Stop));
Set_Unbounded_String
(Node_OnM.VP.all, Subject (Start .. Stop));
Dout
(Img (Stack (S).Node) &
"deferred assignment of " &
@ -5477,7 +5479,7 @@ package body GNAT.Spitbol.Patterns is
Dout
(Img (Node) & "executing immediate assignment of " &
Image (Subject (Stack (Stack_Base - 1).Cursor + 1 .. Cursor)));
Set_String
Set_Unbounded_String
(Node.VP.all,
Subject (Stack (Stack_Base - 1).Cursor + 1 .. Cursor));
Pop_Region;

4
gcc/ada/gnatcmd.adb
View file

@ -872,8 +872,10 @@ procedure GNATCmd is
Close (File);
end if;
-- Don't crash if it is not possible to delete or close the file,
-- just ignore the situation.
exception
-- Don't crash if it is not possible to delete or close the file
when others =>
null;
end;

2
gcc/ada/make.adb
View file

@ -4352,7 +4352,7 @@ package body Make is
end if;
end if;
-- Put the object directories in ADA_OBJECTS_PATH.
-- Put the object directories in ADA_OBJECTS_PATH
Prj.Env.Set_Ada_Paths
(Main_Project,

2
gcc/ada/opt.ads
View file

@ -603,7 +603,7 @@ package Opt is
-- Also forces generation of tree file if -gnatt is also set.
Disable_ALI_File : Boolean := False;
-- GNAT2WHY
-- GNAT
-- Disable generation of ALI file
Force_Checking_Of_Elaboration_Flags : Boolean := False;

4
gcc/ada/prj-conf.adb
View file

@ -911,7 +911,7 @@ package body Prj.Conf is
if Subdirs /= null then
Add_Char_To_Name_Buffer (Directory_Separator);
Add_Str_To_Name_Buffer (Subdirs.all);
Add_Str_To_Name_Buffer (Subdirs.all);
end if;
for J in 1 .. Name_Len loop
@ -989,10 +989,8 @@ package body Prj.Conf is
procedure Check_RTS_Switches is
Switch_Array : Array_Element;
Switch_List : String_List_Id := Nil_String;
Switch : String_Element;
Lang : Name_Id;
Lang_Last : Positive;

2
gcc/ada/s-ficobl.ads
View file

@ -122,7 +122,7 @@ package System.File_Control_Block is
-- Indicates sharing status of file, see description of type above
Access_Method : Character;
-- Set to 'Q', 'S', 'T, 'D' for Sequential_IO, Stream_IO, Text_IO,
-- Set to 'Q', 'S', 'T', 'D' for Sequential_IO, Stream_IO, Text_IO,
-- Direct_IO file (used to validate file sharing request).
Next : AFCB_Ptr;

34
gcc/ada/sem_attr.adb
View file

@ -2110,13 +2110,13 @@ package body Sem_Attr is
case Attr_Id is
-- Attributes related to Ada2012 iterators (Placeholder).
-- Attributes related to Ada2012 iterators (placeholder ???)
when Attribute_Constant_Indexing => null;
when Attribute_Default_Iterator => null;
when Attribute_Constant_Indexing => null;
when Attribute_Default_Iterator => null;
when Attribute_Implicit_Dereference => null;
when Attribute_Iterator_Element => null;
when Attribute_Variable_Indexing => null;
when Attribute_Iterator_Element => null;
when Attribute_Variable_Indexing => null;
------------------
-- Abort_Signal --
@ -5967,23 +5967,23 @@ package body Sem_Attr is
-- test Static as required in cases where it makes a difference.
-- In the case where Static is not set, we do know that all the
-- expressions present are at least known at compile time (we
-- assumed above that if this was not the case, then there was
-- no hope of static evaluation). However, we did not require
-- that the bounds of the prefix type be compile time known,
-- let alone static). That's because there are many attributes
-- that can be computed at compile time on non-static subtypes,
-- even though such references are not static expressions.
-- expressions present are at least known at compile time (we assumed
-- above that if this was not the case, then there was no hope of static
-- evaluation). However, we did not require that the bounds of the
-- prefix type be compile time known, let alone static). That's because
-- there are many attributes that can be computed at compile time on
-- non-static subtypes, even though such references are not static
-- expressions.
case Id is
-- Attributes related to Ada2012 iterators (Placeholder).
-- Attributes related to Ada2012 iterators (placeholder ???)
when Attribute_Constant_Indexing => null;
when Attribute_Default_Iterator => null;
when Attribute_Constant_Indexing => null;
when Attribute_Default_Iterator => null;
when Attribute_Implicit_Dereference => null;
when Attribute_Iterator_Element => null;
when Attribute_Variable_Indexing => null;
when Attribute_Iterator_Element => null;
when Attribute_Variable_Indexing => null;
--------------
-- Adjacent --

3
gcc/ada/sem_ch12.adb
View file

@ -2194,6 +2194,7 @@ package body Sem_Ch12 is
while Nkind (Gen_Name) = N_Expanded_Name loop
Gen_Name := Prefix (Gen_Name);
end loop;
if Chars (Gen_Name) = Chars (Pack_Id) then
Error_Msg_NE
("& is hidden within declaration of formal package",
@ -2285,6 +2286,7 @@ package body Sem_Ch12 is
-- The formals for which associations are provided are not visible
-- outside of the formal package. The others are still declared by a
-- formal parameter declaration.
-- If there are no associations, the only local entity to hide is the
-- generated package renaming itself.
@ -2294,7 +2296,6 @@ package body Sem_Ch12 is
begin
E := First_Entity (Formal);
while Present (E) loop
if Associations
and then not Is_Generic_Formal (E)
then

13
gcc/ada/sem_ch13.adb
View file

@ -946,7 +946,7 @@ package body Sem_Ch13 is
Delay_Required := False;
-- Aspects related to container iterators.
-- Aspects related to container iterators (fill in later???)
when Aspect_Constant_Indexing |
Aspect_Default_Iterator |
@ -955,7 +955,6 @@ package body Sem_Ch13 is
null;
when Aspect_Implicit_Dereference =>
if not Is_Type (E)
or else not Has_Discriminants (E)
then
@ -978,6 +977,7 @@ package body Sem_Ch13 is
Set_Has_Implicit_Dereference (Disc);
goto Continue;
end if;
Next_Discriminant (Disc);
end loop;
@ -2310,9 +2310,12 @@ package body Sem_Ch13 is
--------------------------
-- Implicit_Dereference --
--------------------------
when Attribute_Implicit_Dereference =>
-- Legality checks already performed above.
null; -- TBD
-- Legality checks already performed above
null; -- TBD???
-----------
-- Input --
@ -5482,6 +5485,8 @@ package body Sem_Ch13 is
Aspect_Value_Size =>
T := Any_Integer;
-- Following to be done later ???
when Aspect_Constant_Indexing |
Aspect_Default_Iterator |
Aspect_Iterator_Element |

5
gcc/ada/sem_ch3.adb
View file

@ -9121,12 +9121,13 @@ package body Sem_Ch3 is
-- AI05-0068: report if there is an overriding
-- non-abstract subprogram that is invisible.
if Is_Hidden (E)
and then not Is_Abstract_Subprogram (E)
then
Error_Msg_NE
("\& subprogram# is not visible",
T, Subp);
("\& subprogram# is not visible",
T, Subp);
else
Error_Msg_NE

2
gcc/ada/sem_elab.adb
View file

@ -1120,7 +1120,7 @@ package body Sem_Elab is
procedure Check_Elab_Call
(N : Node_Id;
Outer_Scope : Entity_Id := Empty;
In_Init_Proc : Boolean := False)
In_Init_Proc : Boolean := False)
is
Ent : Entity_Id;
P : Node_Id;

2
gcc/ada/sem_elab.ads
View file

@ -121,7 +121,7 @@ package Sem_Elab is
procedure Check_Elab_Call
(N : Node_Id;
Outer_Scope : Entity_Id := Empty;
In_Init_Proc : Boolean := False);
In_Init_Proc : Boolean := False);
-- Check a call for possible elaboration problems. The node N is either
-- an N_Function_Call or N_Procedure_Call_Statement node. The Outer_Scope
-- argument indicates whether this is an outer level call from Sem_Res

4
gcc/ada/switch-c.adb
View file

@ -1059,8 +1059,8 @@ package body Switch.C is
("-gnatZ is no longer supported: consider using --RTS=zcx");
-- Note on language version switches: whenever a new language
-- version switch is added, procedure
-- Switch.M.Normalize_Compiler_Switches must be updated.
-- version switch is added, Switch.M.Normalize_Compiler_Switches
-- must be updated.
-- Processing for 83 switch