From: Arnaud Charlet Date: Fri, 5 Aug 2011 14:14:36 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=bb3c784c7dad97ec1ed3fafead1986d4319a5246;p=gcc.git [multiple changes] 2011-08-05 Robert Dewar * 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 * a-stunau.ads, g-spipat.adb: Update comments. From-SVN: r177441 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 90a95460b58..69805dc4f28 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2011-08-05 Robert Dewar + + * 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 + + * a-stunau.ads, g-spipat.adb: Update comments. + 2011-08-05 Bob Duff * a-fihema.ads: Minor comment fix. diff --git a/gcc/ada/a-fihema.adb b/gcc/ada/a-fihema.adb index 7d54f533ace..dca5b1e369e 100644 --- a/gcc/ada/a-fihema.adb +++ b/gcc/ada/a-fihema.adb @@ -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 diff --git a/gcc/ada/a-fihema.ads b/gcc/ada/a-fihema.ads index 41659d6e0d6..e3f412f91e4 100644 --- a/gcc/ada/a-fihema.ads +++ b/gcc/ada/a-fihema.ads @@ -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; diff --git a/gcc/ada/a-stunau.ads b/gcc/ada/a-stunau.ads index fa82740b7de..06cffc589a6 100644 --- a/gcc/ada/a-stunau.ads +++ b/gcc/ada/a-stunau.ads @@ -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 diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 7bb9724fb5c..74d17c7cea7 100755 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -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 -- diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 24e58cc45fb..78c077cc11f 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -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; diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index b10b4267a42..db0fcb1d881 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -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 ----------------------- diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index c0129d8ab54..c6d396ddccd 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -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 -- diff --git a/gcc/ada/g-spipat.adb b/gcc/ada/g-spipat.adb index 4c9502a71ca..b1dacd98dc1 100644 --- a/gcc/ada/g-spipat.adb +++ b/gcc/ada/g-spipat.adb @@ -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; diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 28bccf0db10..0fd1d9462b3 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -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; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 4cc0365b410..a383d7c0fa7 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -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, diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 84f8a2a633f..d7cde533426 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -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; diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 2fa66ac4496..db8312a196d 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -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; diff --git a/gcc/ada/s-ficobl.ads b/gcc/ada/s-ficobl.ads index 0f7dbad6ff3..d3e5ef26ed2 100644 --- a/gcc/ada/s-ficobl.ads +++ b/gcc/ada/s-ficobl.ads @@ -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; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index b4b0f2073cc..de7fd3ef9b2 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -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 -- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 8e45449c81a..97cbd0757b8 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -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 diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 15ae76666fb..4a9e9a94cf1 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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 | diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 459cb1b2174..89583ddf147 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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 diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index fab5370074b..5df43afc43e 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -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; diff --git a/gcc/ada/sem_elab.ads b/gcc/ada/sem_elab.ads index f7a52466a30..2bea37dbe5f 100644 --- a/gcc/ada/sem_elab.ads +++ b/gcc/ada/sem_elab.ads @@ -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 diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index c4189f58796..58d4e13e7ac 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -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