OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2011-12-21  Arnaud Charlet  <charlet@adacore.com>

	* 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  <dewar@adacore.com>

	* 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  <pucci@adacore.com>

	* s-diflio.adb, s-diflio.ads, s-diinio.adb, s-diinio.ads,
	s-llflex.ads: Fix header.

From-SVN: r182578
This commit is contained in:
Arnaud Charlet 2011-12-21 13:08:32 +01:00
parent dea1d3dcea
commit d781a61517
15 changed files with 160 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
2011-12-21 Arnaud Charlet <charlet@adacore.com>
* 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 <dewar@adacore.com>
* 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 <pucci@adacore.com>
* s-diflio.adb, s-diflio.ads, s-diinio.adb, s-diinio.ads,
s-llflex.ads: Fix header.
2011-12-21 Thomas Quinot <quinot@adacore.com>
* thread.c, s-oscons-tmplt.c, init.c (pthread_condattr_setclock): For

12
gcc/ada/a-cbdlli.adb
View File

@ -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);

8
gcc/ada/a-cbdlli.ads
View File

@ -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

12
gcc/ada/a-cdlili.adb
View File

@ -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);

42
gcc/ada/a-cfdlli.adb
View File

@ -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;

4
gcc/ada/a-cfdlli.ads
View File

@ -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.

72
gcc/ada/comperr.adb
View File

@ -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/<unit>.scil and
-- SCIL/<unit>__body.scil
-- SCIL/<unit>__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;
-----------------

4
gcc/ada/err_vars.ads
View File

@ -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;

7
gcc/ada/prj-nmsc.adb
View File

@ -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

4
gcc/ada/prj.adb
View File

@ -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;

10
gcc/ada/s-diflio.adb
View File

@ -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 --
-- <http://www.gnu.org/licenses/>. --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------

10
gcc/ada/s-diflio.ads
View File

@ -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 --
-- <http://www.gnu.org/licenses/>. --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------

10
gcc/ada/s-diinio.adb
View File

@ -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 --
-- <http://www.gnu.org/licenses/>. --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------

10
gcc/ada/s-diinio.ads
View File

@ -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 --
-- <http://www.gnu.org/licenses/>. --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------

12
gcc/ada/s-llflex.ads
View File

@ -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 --
-- <http://www.gnu.org/licenses/>. --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------