+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
-- 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);
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);
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
-- 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);
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);
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;
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;
end if;
end Sort;
- -- Start of processing for Sort
+ -- Start of processing for Sort
begin
if Container.Length <= 1 then
J : Count_Type;
begin
-
if Before.Node /= 0 then
pragma Assert (Vet (Container, Before), "bad cursor in Insert");
end if;
J : Count_Type;
begin
-
if Before.Node /= 0 then
pragma Assert (Vet (Container, Before), "bad cursor in Insert");
end if;
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;
Position : Cursor) return Cursor
is
begin
-
return Next (Object.Container.all, Position);
end Next;
Position : Cursor) return Cursor
is
begin
-
return Previous (Object.Container.all, Position);
end Previous;
-- 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;
New_Item : Element_Type)
is
begin
-
if not Has_Element (Container, Position) then
raise Constraint_Error with "Position cursor has no element";
end if;
begin
N (Position.Node).Element := New_Item;
end;
+
+ -- Above is peculiar, why not simply
+ -- Container.Nodes (Position.Node).Element := New_Item ???
+
end Replace_Element;
----------------------
end if;
end Swap;
- -- Start of processing for Reverse_Elements
+ -- Start of processing for Reverse_Elements
begin
if Container.Length <= 1 then
Position : Cursor := No_Element) return Cursor
is
CFirst : Count_Type := Position.Node;
+
begin
if CFirst = 0 then
CFirst := Container.First;
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;
Target_Position : Cursor;
begin
-
if Target'Address = Source'Address then
Splice (Target, Before, Position);
return;
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.
-----------------------
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.
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;
-----------------
-- 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;
(Project : Project_Id;
Data : in out Tree_Processing_Data)
is
-
procedure Check_Not_Defined (Name : Name_Id);
-- Report an error if Var is defined
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);
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
-------------------------
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;
else
Write_Line (" """ & Get_Name_String (Str2) & '"');
end if;
+
Set_Standard_Output;
end if;
end Debug_Output;
------------------------------------------------------------------------------
-- --
--- 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- --
-- 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. --
-- --
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- --
--- 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- --
-- 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. --
-- --
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- --
--- 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- --
-- 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. --
-- --
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- --
--- 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- --
-- 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. --
-- --
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- --
--- 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- --
-- 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. --
-- --
------------------------------------------------------------------------------
projects / platform / upstream / gcc.git / commitdiff