From 069127c27bbc1c9c92d1177d4b38befe7dd0c062 Mon Sep 17 00:00:00 2001 From: charlet Date: Wed, 21 Dec 2011 12:08:32 +0000 Subject: [PATCH] 2011-12-21 Arnaud Charlet * comperr.adb (Delete_SCIL_Files): Also delete .scilx files. Fix implementation for child packages and package specs. (Delete_SCIL_Files.Decode_Name_Buffer): New function. 2011-12-21 Robert Dewar * err_vars.ads, a-cdlili.adb, a-cfdlli.ads, prj.adb, prj-nmsc.adb, a-cbdlli.adb, a-cbdlli.ads, a-cfdlli.adb: Minor reformatting. 2011-12-21 Vincent Pucci * s-diflio.adb, s-diflio.ads, s-diinio.adb, s-diinio.ads, s-llflex.ads: Fix header. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@182578 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 16 ++++++++++++ gcc/ada/a-cbdlli.adb | 12 ++++++--- gcc/ada/a-cbdlli.ads | 8 +++--- gcc/ada/a-cdlili.adb | 12 ++++++--- gcc/ada/a-cfdlli.adb | 42 +++++++++++++++--------------- gcc/ada/a-cfdlli.ads | 4 +-- gcc/ada/comperr.adb | 72 ++++++++++++++++++++++++++++++++++++++++++++++------ gcc/ada/err_vars.ads | 4 ++- gcc/ada/prj-nmsc.adb | 7 ++--- gcc/ada/prj.adb | 4 ++- gcc/ada/s-diflio.adb | 10 ++++---- gcc/ada/s-diflio.ads | 10 ++++---- gcc/ada/s-diinio.adb | 10 ++++---- gcc/ada/s-diinio.ads | 10 ++++---- gcc/ada/s-llflex.ads | 12 ++++----- 15 files changed, 160 insertions(+), 73 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 40a663f..3094b46 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2011-12-21 Arnaud Charlet + + * comperr.adb (Delete_SCIL_Files): Also delete .scilx files. + Fix implementation for child packages and package specs. + (Delete_SCIL_Files.Decode_Name_Buffer): New function. + +2011-12-21 Robert Dewar + + * err_vars.ads, a-cdlili.adb, a-cfdlli.ads, prj.adb, prj-nmsc.adb, + a-cbdlli.adb, a-cbdlli.ads, a-cfdlli.adb: Minor reformatting. + +2011-12-21 Vincent Pucci + + * s-diflio.adb, s-diflio.ads, s-diinio.adb, s-diinio.ads, + s-llflex.ads: Fix header. + 2011-12-21 Thomas Quinot * thread.c, s-oscons-tmplt.c, init.c (pthread_condattr_setclock): For diff --git a/gcc/ada/a-cbdlli.adb b/gcc/ada/a-cbdlli.adb index 5e4248a..25113d0 100644 --- a/gcc/ada/a-cbdlli.adb +++ b/gcc/ada/a-cbdlli.adb @@ -1537,8 +1537,10 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is -- Reference -- --------------- - function Constant_Reference (Container : List; Position : Cursor) - return Constant_Reference_Type is + function Constant_Reference + (Container : List; + Position : Cursor) return Constant_Reference_Type + is begin pragma Unreferenced (Container); @@ -1550,8 +1552,10 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is Position.Container.Nodes (Position.Node).Element'Unrestricted_Access); end Constant_Reference; - function Reference (Container : List; Position : Cursor) - return Reference_Type is + function Reference + (Container : List; + Position : Cursor) return Reference_Type + is begin pragma Unreferenced (Container); diff --git a/gcc/ada/a-cbdlli.ads b/gcc/ada/a-cbdlli.ads index 0443c30..df0633f 100644 --- a/gcc/ada/a-cbdlli.ads +++ b/gcc/ada/a-cbdlli.ads @@ -258,12 +258,12 @@ package Ada.Containers.Bounded_Doubly_Linked_Lists is for Reference_Type'Read use Read; function Constant_Reference - (Container : List; Position : Cursor) -- SHOULD BE ALIASED - return Constant_Reference_Type; + (Container : List; -- SHOULD BE ALIASED ??? + Position : Cursor) return Constant_Reference_Type; function Reference - (Container : List; Position : Cursor) -- SHOULD BE ALIASED - return Reference_Type; + (Container : List; -- SHOULD BE ALIASED ??? + Position : Cursor) return Reference_Type; private diff --git a/gcc/ada/a-cdlili.adb b/gcc/ada/a-cdlili.adb index 67df309..f56578c 100644 --- a/gcc/ada/a-cdlili.adb +++ b/gcc/ada/a-cdlili.adb @@ -1277,8 +1277,10 @@ package body Ada.Containers.Doubly_Linked_Lists is -- Reference -- --------------- - function Constant_Reference (Container : List; Position : Cursor) - return Constant_Reference_Type is + function Constant_Reference + (Container : List; + Position : Cursor) return Constant_Reference_Type + is begin pragma Unreferenced (Container); @@ -1289,8 +1291,10 @@ package body Ada.Containers.Doubly_Linked_Lists is return (Element => Position.Node.Element'Access); end Constant_Reference; - function Reference (Container : List; Position : Cursor) - return Reference_Type is + function Reference + (Container : List; + Position : Cursor) return Reference_Type + is begin pragma Unreferenced (Container); diff --git a/gcc/ada/a-cfdlli.adb b/gcc/ada/a-cfdlli.adb index 9c4ff11..80e6fc0 100644 --- a/gcc/ada/a-cfdlli.adb +++ b/gcc/ada/a-cfdlli.adb @@ -253,10 +253,11 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is Capacity : Count_Type := 0) return List is C : constant Count_Type := Count_Type'Max (Source.Capacity, Capacity); - N : Count_Type := 1; + N : Count_Type; P : List (C); begin + N := 1; while N <= Source.Capacity loop P.Nodes (N).Prev := Source.Nodes (N).Prev; P.Nodes (N).Next := Source.Nodes (N).Next; @@ -604,12 +605,12 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is Node : Count_Type := Container.First; begin - for I in 2 .. Container.Length loop + for J in 2 .. Container.Length loop if Nodes (Nodes (Node).Next).Element < Nodes (Node).Element then return False; + else + Node := Nodes (Node).Next; end if; - - Node := Nodes (Node).Next; end loop; return True; @@ -749,7 +750,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is end if; end Sort; - -- Start of processing for Sort + -- Start of processing for Sort begin if Container.Length <= 1 then @@ -799,7 +800,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is J : Count_Type; begin - if Before.Node /= 0 then pragma Assert (Vet (Container, Before), "bad cursor in Insert"); end if; @@ -848,7 +848,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is J : Count_Type; begin - if Before.Node /= 0 then pragma Assert (Vet (Container, Before), "bad cursor in Insert"); end if; @@ -950,15 +949,15 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is Process : not null access procedure (Container : List; Position : Cursor)) is - C : List renames Container'Unrestricted_Access.all; - B : Natural renames C.Busy; - - Node : Count_Type := Container.First; + C : List renames Container'Unrestricted_Access.all; + B : Natural renames C.Busy; + Node : Count_Type; begin B := B + 1; begin + Node := Container.First; while Node /= 0 loop Process (Container, (Node => Node)); Node := Container.Nodes (Node).Next; @@ -1235,7 +1234,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is Position : Cursor) return Cursor is begin - return Next (Object.Container.all, Position); end Next; @@ -1288,7 +1286,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is Position : Cursor) return Cursor is begin - return Previous (Object.Container.all, Position); end Previous; @@ -1372,10 +1369,11 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is -- Reference -- --------------- - function Constant_Reference (Container : List; Position : Cursor) - return Constant_Reference_Type is + function Constant_Reference + (Container : List; + Position : Cursor) return Constant_Reference_Type + is begin - if not Has_Element (Container, Position) then raise Constraint_Error with "Position cursor has no element"; end if; @@ -1393,7 +1391,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is New_Item : Element_Type) is begin - if not Has_Element (Container, Position) then raise Constraint_Error with "Position cursor has no element"; end if; @@ -1411,6 +1408,10 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is begin N (Position.Node).Element := New_Item; end; + + -- Above is peculiar, why not simply + -- Container.Nodes (Position.Node).Element := New_Item ??? + end Replace_Element; ---------------------- @@ -1462,7 +1463,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is end if; end Swap; - -- Start of processing for Reverse_Elements + -- Start of processing for Reverse_Elements begin if Container.Length <= 1 then @@ -1511,6 +1512,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is Position : Cursor := No_Element) return Cursor is CFirst : Count_Type := Position.Node; + begin if CFirst = 0 then CFirst := Container.First; @@ -1542,12 +1544,13 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is C : List renames Container'Unrestricted_Access.all; B : Natural renames C.Busy; - Node : Count_Type := Container.Last; + Node : Count_Type; begin B := B + 1; begin + Node := Container.Last; while Node /= 0 loop Process (Container, (Node => Node)); Node := Container.Nodes (Node).Prev; @@ -1649,7 +1652,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is Target_Position : Cursor; begin - if Target'Address = Source'Address then Splice (Target, Before, Position); return; diff --git a/gcc/ada/a-cfdlli.ads b/gcc/ada/a-cfdlli.ads index c6deaf1..8bf8a3d 100644 --- a/gcc/ada/a-cfdlli.ads +++ b/gcc/ada/a-cfdlli.ads @@ -246,8 +246,8 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is Implicit_Dereference => Element; function Constant_Reference - (Container : List; Position : Cursor) -- SHOULD BE ALIASED - return Constant_Reference_Type; + (Container : List; -- SHOULD BE ALIASED ??? + Position : Cursor) return Constant_Reference_Type; function Strict_Equal (Left, Right : List) return Boolean; -- Strict_Equal returns True if the containers are physically equal, i.e. diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb index d21b3ec..099dc85 100644 --- a/gcc/ada/comperr.adb +++ b/gcc/ada/comperr.adb @@ -438,10 +438,41 @@ package body Comperr is ----------------------- procedure Delete_SCIL_Files is - Main : Node_Id; - Success : Boolean; + Main : Node_Id; + Unit_Name : Node_Id; + Success : Boolean; pragma Unreferenced (Success); + procedure Decode_Name_Buffer; + -- Replace "__" by "." in Name_Buffer, and adjust Name_Len accordingly + + ------------------------ + -- Decode_Name_Buffer -- + ------------------------ + + procedure Decode_Name_Buffer is + J : Natural := 1; + K : Natural := 0; + begin + while J <= Name_Len loop + K := K + 1; + + if J < Name_Len + and then Name_Buffer (J) = '_' + and then Name_Buffer (J + 1) = '_' + then + Name_Buffer (K) := '.'; + J := J + 1; + else + Name_Buffer (K) := Name_Buffer (J); + end if; + + J := J + 1; + end loop; + + Name_Len := K; + end Decode_Name_Buffer; + begin -- If parsing was not successful, no Main_Unit is available, so return -- immediately. @@ -451,20 +482,45 @@ package body Comperr is end if; -- Retrieve unit name, and remove old versions of SCIL/.scil and - -- SCIL/__body.scil + -- SCIL/__body.scil, ditto for .scilx files. Main := Unit (Cunit (Main_Unit)); - if Nkind (Main) = N_Subprogram_Body then - Get_Name_String (Chars (Defining_Unit_Name (Specification (Main)))); - else - Get_Name_String (Chars (Defining_Unit_Name (Main))); - end if; + case Nkind (Main) is + when N_Subprogram_Body | N_Package_Declaration => + Unit_Name := Defining_Unit_Name (Specification (Main)); + + when N_Package_Body => + Unit_Name := Corresponding_Spec (Main); + + when others => + -- Should never happen, but can be ignored in production + pragma Assert (False); + return; + end case; + + case Nkind (Unit_Name) is + when N_Defining_Identifier => + Get_Name_String (Chars (Unit_Name)); + + when N_Defining_Program_Unit_Name => + Get_Name_String (Chars (Defining_Identifier (Unit_Name))); + Decode_Name_Buffer; + + when others => + -- Should never happen, but can be ignored in production + pragma Assert (False); + return; + end case; Delete_File ("SCIL/" & Name_Buffer (1 .. Name_Len) & ".scil", Success); Delete_File + ("SCIL/" & Name_Buffer (1 .. Name_Len) & ".scilx", Success); + Delete_File ("SCIL/" & Name_Buffer (1 .. Name_Len) & "__body.scil", Success); + Delete_File + ("SCIL/" & Name_Buffer (1 .. Name_Len) & "__body.scilx", Success); end Delete_SCIL_Files; ----------------- diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads index 90f1491..e17e1fe 100644 --- a/gcc/ada/err_vars.ads +++ b/gcc/ada/err_vars.ads @@ -145,7 +145,9 @@ package Err_Vars is -- Used if current message contains a < insertion character to indicate -- if the current message is a warning message. Must be set appropriately -- before any call to Error_Msg_xxx with a < insertion character present. - -- Setting is irrelevant if no < insertion character is present. + -- Setting is irrelevant if no < insertion character is present. Note + -- that it is not necessary to reset this after using it, since the proper + -- procedure is always to set it before issuing such a message. Error_Msg_String : String (1 .. 4096); Error_Msg_Strlen : Natural; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index af725de..b018026 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -1042,7 +1042,6 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is - procedure Check_Not_Defined (Name : Name_Id); -- Report an error if Var is defined @@ -1065,6 +1064,8 @@ package body Prj.Nmsc is end if; end Check_Not_Defined; + -- Start of processing for Check_Not_Defined + begin Check_Not_Defined (Snames.Name_Library_Dir); Check_Not_Defined (Snames.Name_Library_Interface); @@ -1116,9 +1117,9 @@ package body Prj.Nmsc is Check_Configuration (Project, Data); + -- For aggregate project checks that no library attributes are defined + if Project.Qualifier = Aggregate then - -- For aggregate project checks that no library attributes are - -- defined. Check_Aggregate (Project, Data); else diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index fc5b34c..97b23bd 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -390,8 +390,9 @@ package body Prj is ------------------------- function Is_Allowed_Language (Name : Name_Id) return Boolean is - R : Restricted_Lang_Access := Restricted_Languages; + R : Restricted_Lang_Access := Restricted_Languages; Lang : constant String := Get_Name_String (Name); + begin if R = null then return True; @@ -1633,6 +1634,7 @@ package body Prj is else Write_Line (" """ & Get_Name_String (Str2) & '"'); end if; + Set_Standard_Output; end if; end Debug_Output; diff --git a/gcc/ada/s-diflio.adb b/gcc/ada/s-diflio.adb index 46b24cd..e13abf9 100644 --- a/gcc/ada/s-diflio.adb +++ b/gcc/ada/s-diflio.adb @@ -1,14 +1,14 @@ ------------------------------------------------------------------------------ -- -- --- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- GNAT RUN-TIME COMPONENTS -- -- -- -- S Y S T E M . D I M _ F L O A T _ I O -- -- -- --- B o d y -- +-- B o d y -- -- -- -- Copyright (C) 2011, Free Software Foundation, Inc. -- -- -- --- GNARL 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- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- @@ -24,8 +24,8 @@ -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ diff --git a/gcc/ada/s-diflio.ads b/gcc/ada/s-diflio.ads index 0a952de..3e04ea1 100644 --- a/gcc/ada/s-diflio.ads +++ b/gcc/ada/s-diflio.ads @@ -1,14 +1,14 @@ ------------------------------------------------------------------------------ -- -- --- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- GNAT RUN-TIME COMPONENTS -- -- -- -- S Y S T E M . D I M _ F L O A T _ I O -- -- -- --- S p e c -- +-- S p e c -- -- -- -- Copyright (C) 2011, Free Software Foundation, Inc. -- -- -- --- GNARL 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- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- @@ -24,8 +24,8 @@ -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ diff --git a/gcc/ada/s-diinio.adb b/gcc/ada/s-diinio.adb index 75f5768..e8d8f5d 100644 --- a/gcc/ada/s-diinio.adb +++ b/gcc/ada/s-diinio.adb @@ -1,14 +1,14 @@ ------------------------------------------------------------------------------ -- -- --- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- GNAT RUN-TIME COMPONENTS -- -- -- -- S Y S T E M . D I M _ I N T E G E R _ I O -- -- -- --- B o d y -- +-- B o d y -- -- -- -- Copyright (C) 2011, Free Software Foundation, Inc. -- -- -- --- GNARL 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- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- @@ -24,8 +24,8 @@ -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ diff --git a/gcc/ada/s-diinio.ads b/gcc/ada/s-diinio.ads index 098b880..00db9af 100644 --- a/gcc/ada/s-diinio.ads +++ b/gcc/ada/s-diinio.ads @@ -1,14 +1,14 @@ ------------------------------------------------------------------------------ -- -- --- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- GNAT RUN-TIME COMPONENTS -- -- -- -- S Y S T E M . D I M _ I N T E G E R _ I O -- -- -- --- S p e c -- +-- S p e c -- -- -- -- Copyright (C) 2011, Free Software Foundation, Inc. -- -- -- --- GNARL 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- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- @@ -24,8 +24,8 @@ -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ diff --git a/gcc/ada/s-llflex.ads b/gcc/ada/s-llflex.ads index bd6d8b2..c47d496 100644 --- a/gcc/ada/s-llflex.ads +++ b/gcc/ada/s-llflex.ads @@ -1,14 +1,14 @@ ------------------------------------------------------------------------------ -- -- --- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- GNAT RUN-TIME COMPONENTS -- -- -- -- S Y S T E M . L O N G _ L O N G _ F L O A T _ E X P O N -- -- -- --- S p e c -- +-- S p e c -- -- -- --- Copyright (C) 2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2011, Free Software Foundation, Inc. -- -- -- --- GNARL 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- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- @@ -24,8 +24,8 @@ -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ -- 2.7.4