[multiple changes]
2014-07-30 Robert Dewar <dewar@adacore.com> * clean.adb: Minor reformatting. * opt.ads: Minor fix to incorrect comment. 2014-07-30 Ed Schonberg <schonberg@adacore.com> * a-chtgbo.ads, a-chtgbo.adb (Delete_Node_At_Index): New subprogram, used by bounded hashed sets, to delete a node at a given index, whose element may have been improperly updated through a Reference_Preserving key. * a-cbhase.ads: Add Reference_Control_Type to package Generic_Keys. * a-cbhase.adb: Add Adjust and Finalize routines for Reference_Control_Type. (Delete, Insert): Raise Program_Error, not Constraint_Error, when operation is illegal. (Reference_Preserving_Key): Build aggregate for Reference_Control_Type * a-cmbutr.ads: Add Reference_Control_Type to detect tampering. Add private with_clause for Ada.Finalization. * a-cbmutr.adb: Add Adjust and Finalize routines for Reference_Control_Type. Use it in the construction of Reference and Constant_Reference values. From-SVN: r213285
This commit is contained in:
Arnaud Charlet
parent
c98b825308
commit
2b4c962d78
|
|
@ -1,3 +1,26 @@
|
|||
2014-07-30 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* clean.adb: Minor reformatting.
|
||||
* opt.ads: Minor fix to incorrect comment.
|
||||
|
||||
2014-07-30 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* a-chtgbo.ads, a-chtgbo.adb (Delete_Node_At_Index): New
|
||||
subprogram, used by bounded hashed sets, to delete a node at
|
||||
a given index, whose element may have been improperly updated
|
||||
through a Reference_Preserving key.
|
||||
* a-cbhase.ads: Add Reference_Control_Type to package Generic_Keys.
|
||||
* a-cbhase.adb: Add Adjust and Finalize routines for
|
||||
Reference_Control_Type.
|
||||
(Delete, Insert): Raise Program_Error, not Constraint_Error,
|
||||
when operation is illegal.
|
||||
(Reference_Preserving_Key): Build aggregate for Reference_Control_Type
|
||||
* a-cmbutr.ads: Add Reference_Control_Type to detect tampering. Add
|
||||
private with_clause for Ada.Finalization.
|
||||
* a-cbmutr.adb: Add Adjust and Finalize routines for
|
||||
Reference_Control_Type. Use it in the construction of Reference
|
||||
and Constant_Reference values.
|
||||
|
||||
2014-07-30 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch3.adb, sem_ch3.ads: Minor code reorganization.
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
------------------------------------------------------------------------------
|
||||
-------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT LIBRARY COMPONENTS --
|
||||
-- --
|
||||
|
|
@ -313,7 +313,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
|||
Element_Keys.Delete_Key_Sans_Free (Container, Item, X);
|
||||
|
||||
if X = 0 then
|
||||
raise Constraint_Error with "attempt to delete element not in set";
|
||||
raise Program_Error with "attempt to delete element not in set";
|
||||
end if;
|
||||
|
||||
HT_Ops.Free (Container, X);
|
||||
|
|
@ -762,7 +762,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
|||
Insert (Container, New_Item, Position, Inserted);
|
||||
|
||||
if not Inserted then
|
||||
raise Constraint_Error with
|
||||
raise Program_Error with
|
||||
"attempt to insert element already in set";
|
||||
end if;
|
||||
end Insert;
|
||||
|
|
@ -1621,6 +1621,23 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
|||
-- Local Subprograms --
|
||||
-----------------------
|
||||
|
||||
------------
|
||||
-- Adjust --
|
||||
------------
|
||||
|
||||
procedure Adjust (Control : in out Reference_Control_Type) is
|
||||
begin
|
||||
if Control.Container /= null then
|
||||
declare
|
||||
B : Natural renames Control.Container.Busy;
|
||||
L : Natural renames Control.Container.Lock;
|
||||
begin
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
end;
|
||||
end if;
|
||||
end Adjust;
|
||||
|
||||
function Equivalent_Key_Node
|
||||
(Key : Key_Type;
|
||||
Node : Node_Type) return Boolean;
|
||||
|
|
@ -1751,6 +1768,32 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
|||
HT_Ops.Free (Container, X);
|
||||
end Exclude;
|
||||
|
||||
--------------
|
||||
-- Finalize --
|
||||
--------------
|
||||
|
||||
procedure Finalize (Control : in out Reference_Control_Type) is
|
||||
begin
|
||||
if Control.Container /= null then
|
||||
declare
|
||||
B : Natural renames Control.Container.Busy;
|
||||
L : Natural renames Control.Container.Lock;
|
||||
begin
|
||||
B := B - 1;
|
||||
L := L - 1;
|
||||
end;
|
||||
|
||||
if Hash (Key (Element (Control.Old_Pos))) /= Control.Old_Hash
|
||||
then
|
||||
HT_Ops.Delete_Node_At_Index
|
||||
(Control.Container.all, Control.Index, Control.Old_Pos.Node);
|
||||
raise Program_Error with "key not preserved in reference";
|
||||
end if;
|
||||
|
||||
Control.Container := null;
|
||||
end if;
|
||||
end Finalize;
|
||||
|
||||
----------
|
||||
-- Find --
|
||||
----------
|
||||
|
|
@ -1815,14 +1858,25 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
|||
(Vet (Position),
|
||||
"bad cursor in function Reference_Preserving_Key");
|
||||
|
||||
-- Some form of finalization will be required in order to actually
|
||||
-- check that the key-part of the element designated by Position has
|
||||
-- not changed. ???
|
||||
|
||||
declare
|
||||
N : Node_Type renames Container.Nodes (Position.Node);
|
||||
B : Natural renames Container.Busy;
|
||||
L : Natural renames Container.Lock;
|
||||
|
||||
begin
|
||||
return (Element => N.Element'Access);
|
||||
return R : constant Reference_Type :=
|
||||
(Element => N.Element'Unrestricted_Access,
|
||||
Control =>
|
||||
(Controlled with
|
||||
Container'Unrestricted_Access,
|
||||
Index =>
|
||||
Key_Keys.Index (Container, Key (Position)),
|
||||
Old_Pos => Position,
|
||||
Old_Hash => Hash (Key (Position))))
|
||||
do
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
end return;
|
||||
end;
|
||||
end Reference_Preserving_Key;
|
||||
|
||||
|
|
@ -1838,9 +1892,23 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
|||
end if;
|
||||
|
||||
declare
|
||||
N : Node_Type renames Container.Nodes (Node);
|
||||
P : constant Cursor := Find (Container, Key);
|
||||
B : Natural renames Container.Busy;
|
||||
L : Natural renames Container.Lock;
|
||||
|
||||
begin
|
||||
return (Element => N.Element'Access);
|
||||
return R : constant Reference_Type :=
|
||||
(Element => Container.Nodes (Node).Element'Unrestricted_Access,
|
||||
Control =>
|
||||
(Controlled with
|
||||
Container'Unrestricted_Access,
|
||||
Index => Key_Keys.Index (Container, Key),
|
||||
Old_Pos => P,
|
||||
Old_Hash => Hash (Key)))
|
||||
do
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
end return;
|
||||
end;
|
||||
end Reference_Preserving_Key;
|
||||
|
||||
|
|
|
|||
|
|
@ -444,8 +444,29 @@ package Ada.Containers.Bounded_Hashed_Sets is
|
|||
Key : Key_Type) return Reference_Type;
|
||||
|
||||
private
|
||||
type Reference_Type (Element : not null access Element_Type) is
|
||||
null record;
|
||||
type Set_Access is access all Set;
|
||||
for Set_Access'Storage_Size use 0;
|
||||
|
||||
type Reference_Control_Type is
|
||||
new Ada.Finalization.Controlled with
|
||||
record
|
||||
Container : Set_Access;
|
||||
Index : Hash_Type;
|
||||
Old_Pos : Cursor;
|
||||
Old_Hash : Hash_Type;
|
||||
end record;
|
||||
|
||||
overriding procedure
|
||||
Adjust (Control : in out Reference_Control_Type);
|
||||
pragma Inline (Adjust);
|
||||
|
||||
overriding procedure
|
||||
Finalize (Control : in out Reference_Control_Type);
|
||||
pragma Inline (Finalize);
|
||||
|
||||
type Reference_Type (Element : not null access Element_Type) is record
|
||||
Control : Reference_Control_Type;
|
||||
end record;
|
||||
|
||||
use Ada.Streams;
|
||||
|
||||
|
|
|
|||
|
|
@ -27,8 +27,6 @@
|
|||
-- This unit was originally developed by Matthew J Heaney. --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Finalization; use Ada.Finalization;
|
||||
|
||||
with System; use type System.Address;
|
||||
|
||||
package body Ada.Containers.Bounded_Multiway_Trees is
|
||||
|
|
@ -236,6 +234,24 @@ package body Ada.Containers.Bounded_Multiway_Trees is
|
|||
Right_Subtree => Root_Node (Right));
|
||||
end "=";
|
||||
|
||||
------------
|
||||
-- Adjust --
|
||||
------------
|
||||
|
||||
procedure Adjust (Control : in out Reference_Control_Type) is
|
||||
begin
|
||||
if Control.Container /= null then
|
||||
declare
|
||||
C : Tree renames Control.Container.all;
|
||||
B : Natural renames C.Busy;
|
||||
L : Natural renames C.Lock;
|
||||
begin
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
end;
|
||||
end if;
|
||||
end Adjust;
|
||||
|
||||
-------------------
|
||||
-- Allocate_Node --
|
||||
-------------------
|
||||
|
|
@ -329,12 +345,6 @@ package body Ada.Containers.Bounded_Multiway_Trees is
|
|||
raise Constraint_Error with "Position cursor has no element";
|
||||
end if;
|
||||
|
||||
-- Commented-out pending ruling by ARG. ???
|
||||
|
||||
-- if Position.Container /= Container'Unrestricted_Access then
|
||||
-- raise Program_Error with "Position cursor not in container";
|
||||
-- end if;
|
||||
|
||||
-- AI-0136 says to raise PE if Position equals the root node. This does
|
||||
-- not seem correct, as this value is just the limiting condition of the
|
||||
-- search. For now we omit this check, pending a ruling from the ARG.
|
||||
|
|
@ -602,7 +612,20 @@ package body Ada.Containers.Bounded_Multiway_Trees is
|
|||
-- pragma Assert (Vet (Position),
|
||||
-- "Position cursor in Constant_Reference is bad");
|
||||
|
||||
return (Element => Container.Elements (Position.Node)'Access);
|
||||
declare
|
||||
C : Tree renames Position.Container.all;
|
||||
B : Natural renames C.Busy;
|
||||
L : Natural renames C.Lock;
|
||||
|
||||
begin
|
||||
return R : constant Constant_Reference_Type :=
|
||||
(Element => Container.Elements (Position.Node)'Access,
|
||||
Control => (Controlled with Container'Unrestricted_Access))
|
||||
do
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
end return;
|
||||
end;
|
||||
end Constant_Reference;
|
||||
|
||||
--------------
|
||||
|
|
@ -1270,6 +1293,22 @@ package body Ada.Containers.Bounded_Multiway_Trees is
|
|||
B := B - 1;
|
||||
end Finalize;
|
||||
|
||||
procedure Finalize (Control : in out Reference_Control_Type) is
|
||||
begin
|
||||
if Control.Container /= null then
|
||||
declare
|
||||
C : Tree renames Control.Container.all;
|
||||
B : Natural renames C.Busy;
|
||||
L : Natural renames C.Lock;
|
||||
begin
|
||||
B := B - 1;
|
||||
L := L - 1;
|
||||
end;
|
||||
|
||||
Control.Container := null;
|
||||
end if;
|
||||
end Finalize;
|
||||
|
||||
----------
|
||||
-- Find --
|
||||
----------
|
||||
|
|
@ -2516,7 +2555,20 @@ package body Ada.Containers.Bounded_Multiway_Trees is
|
|||
-- pragma Assert (Vet (Position),
|
||||
-- "Position cursor in Constant_Reference is bad");
|
||||
|
||||
return (Element => Container.Elements (Position.Node)'Access);
|
||||
declare
|
||||
C : Tree renames Position.Container.all;
|
||||
B : Natural renames C.Busy;
|
||||
L : Natural renames C.Lock;
|
||||
begin
|
||||
return R : constant Reference_Type :=
|
||||
(Element => Container.Elements (Position.Node)'Access,
|
||||
Control => (Controlled with Position.Container))
|
||||
do
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
end return;
|
||||
end;
|
||||
|
||||
end Reference;
|
||||
|
||||
--------------------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2011-2012, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2014, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -33,6 +33,7 @@
|
|||
|
||||
with Ada.Iterator_Interfaces;
|
||||
private with Ada.Streams;
|
||||
private with Ada.Finalization;
|
||||
|
||||
generic
|
||||
type Element_Type is private;
|
||||
|
|
@ -137,34 +138,10 @@ package Ada.Containers.Bounded_Multiway_Trees is
|
|||
(Container : Tree;
|
||||
Item : Element_Type) return Cursor;
|
||||
|
||||
-- This version of the AI:
|
||||
-- 10-06-02 AI05-0136-1/07
|
||||
-- declares Find_In_Subtree this way:
|
||||
--
|
||||
-- function Find_In_Subtree
|
||||
-- (Container : Tree;
|
||||
-- Item : Element_Type;
|
||||
-- Position : Cursor) return Cursor;
|
||||
--
|
||||
-- It seems that the Container parameter is there by mistake, but we need
|
||||
-- an official ruling from the ARG. ???
|
||||
|
||||
function Find_In_Subtree
|
||||
(Position : Cursor;
|
||||
Item : Element_Type) return Cursor;
|
||||
|
||||
-- This version of the AI:
|
||||
-- 10-06-02 AI05-0136-1/07
|
||||
-- declares Ancestor_Find this way:
|
||||
--
|
||||
-- function Ancestor_Find
|
||||
-- (Container : Tree;
|
||||
-- Item : Element_Type;
|
||||
-- Position : Cursor) return Cursor;
|
||||
--
|
||||
-- It seems that the Container parameter is there by mistake, but we need
|
||||
-- an official ruling from the ARG. ???
|
||||
|
||||
function Ancestor_Find
|
||||
(Position : Cursor;
|
||||
Item : Element_Type) return Cursor;
|
||||
|
|
@ -284,20 +261,6 @@ package Ada.Containers.Bounded_Multiway_Trees is
|
|||
|
||||
procedure Previous_Sibling (Position : in out Cursor);
|
||||
|
||||
-- This version of the AI:
|
||||
|
||||
-- 10-06-02 AI05-0136-1/07
|
||||
|
||||
-- declares Iterate_Children this way:
|
||||
|
||||
-- procedure Iterate_Children
|
||||
-- (Container : Tree;
|
||||
-- Parent : Cursor;
|
||||
-- Process : not null access procedure (Position : Cursor));
|
||||
|
||||
-- It seems that the Container parameter is there by mistake, but we need
|
||||
-- an official ruling from the ARG. ???
|
||||
|
||||
procedure Iterate_Children
|
||||
(Parent : Cursor;
|
||||
Process : not null access procedure (Position : Cursor));
|
||||
|
|
@ -308,6 +271,7 @@ package Ada.Containers.Bounded_Multiway_Trees is
|
|||
|
||||
private
|
||||
use Ada.Streams;
|
||||
use Ada.Finalization;
|
||||
|
||||
No_Node : constant Count_Type'Base := -1;
|
||||
-- Need to document all global declarations such as this ???
|
||||
|
|
@ -368,8 +332,22 @@ private
|
|||
Position : Cursor);
|
||||
for Cursor'Write use Write;
|
||||
|
||||
type Reference_Control_Type is
|
||||
new Controlled with record
|
||||
Container : Tree_Access;
|
||||
end record;
|
||||
|
||||
overriding procedure Adjust (Control : in out Reference_Control_Type);
|
||||
pragma Inline (Adjust);
|
||||
|
||||
overriding procedure Finalize (Control : in out Reference_Control_Type);
|
||||
pragma Inline (Finalize);
|
||||
|
||||
type Constant_Reference_Type
|
||||
(Element : not null access constant Element_Type) is null record;
|
||||
(Element : not null access constant Element_Type) is
|
||||
record
|
||||
Control : Reference_Control_Type;
|
||||
end record;
|
||||
|
||||
procedure Write
|
||||
(Stream : not null access Root_Stream_Type'Class;
|
||||
|
|
@ -382,7 +360,10 @@ private
|
|||
for Constant_Reference_Type'Read use Read;
|
||||
|
||||
type Reference_Type
|
||||
(Element : not null access Element_Type) is null record;
|
||||
(Element : not null access Element_Type) is
|
||||
record
|
||||
Control : Reference_Control_Type;
|
||||
end record;
|
||||
|
||||
procedure Write
|
||||
(Stream : not null access Root_Stream_Type'Class;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2014, 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- --
|
||||
|
|
@ -81,6 +81,48 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is
|
|||
HT.Buckets := (others => 0); -- optimize this somehow ???
|
||||
end Clear;
|
||||
|
||||
--------------------------
|
||||
-- Delete_Node_At_Index --
|
||||
--------------------------
|
||||
|
||||
procedure Delete_Node_At_Index
|
||||
(HT : in out Hash_Table_Type'Class;
|
||||
Indx : Hash_Type;
|
||||
X : Count_Type)
|
||||
is
|
||||
Prev : Count_Type;
|
||||
Curr : Count_Type;
|
||||
|
||||
begin
|
||||
Prev := HT.Buckets (Indx);
|
||||
|
||||
if Prev = 0 then
|
||||
raise Program_Error with
|
||||
"attempt to delete node from empty hash bucket";
|
||||
end if;
|
||||
|
||||
if Prev = X then
|
||||
HT.Buckets (Indx) := Next (HT.Nodes (Prev));
|
||||
HT.Length := HT.Length - 1;
|
||||
return;
|
||||
end if;
|
||||
if HT.Length = 1 then
|
||||
raise Program_Error with
|
||||
"attempt to delete node not in its proper hash bucket";
|
||||
end if;
|
||||
|
||||
loop
|
||||
Curr := Next (HT.Nodes (Prev));
|
||||
|
||||
if Curr = 0 then
|
||||
raise Program_Error with
|
||||
"attempt to delete node not in its proper hash bucket";
|
||||
end if;
|
||||
|
||||
Prev := Curr;
|
||||
end loop;
|
||||
end Delete_Node_At_Index;
|
||||
|
||||
---------------------------
|
||||
-- Delete_Node_Sans_Free --
|
||||
---------------------------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2014, 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- --
|
||||
|
|
@ -84,6 +84,17 @@ package Ada.Containers.Hash_Tables.Generic_Bounded_Operations is
|
|||
-- the nodes, not the buckets array.) Program_Error is raised if the hash
|
||||
-- table is busy.
|
||||
|
||||
procedure Delete_Node_At_Index
|
||||
(HT : in out Hash_Table_Type'Class;
|
||||
Indx : Hash_Type;
|
||||
X : Count_Type);
|
||||
|
||||
-- Delete a node whose bucket position is known. extracted from following
|
||||
-- subprogram, but also used directly to remove a node whose element has
|
||||
-- been modified through a key_preserving reference: in that case we cannot
|
||||
-- use the value of the element precisely because the current value does
|
||||
-- not correspond to the hash code that determines its bucket.
|
||||
|
||||
procedure Delete_Node_Sans_Free
|
||||
(HT : in out Hash_Table_Type'Class;
|
||||
X : Count_Type);
|
||||
|
|
|
|||
|
|
@ -740,11 +740,12 @@ package body Clean is
|
|||
if Last > 4 and then Name (Last - 3 .. Last) = ".ali" then
|
||||
declare
|
||||
Unit : Unit_Index;
|
||||
|
||||
begin
|
||||
-- Compare with ALI file names of the project
|
||||
|
||||
Unit := Units_Htable.Get_First
|
||||
(Project_Tree.Units_HT);
|
||||
Unit :=
|
||||
Units_Htable.Get_First (Project_Tree.Units_HT);
|
||||
while Unit /= No_Unit_Index loop
|
||||
if Unit.File_Names (Impl) /= null
|
||||
and then Unit.File_Names (Impl).Project /=
|
||||
|
|
@ -756,9 +757,10 @@ package body Clean is
|
|||
then
|
||||
Get_Name_String
|
||||
(Unit.File_Names (Impl).File);
|
||||
Name_Len := Name_Len -
|
||||
File_Extension
|
||||
(Name (1 .. Name_Len))'Length;
|
||||
Name_Len :=
|
||||
Name_Len -
|
||||
File_Extension
|
||||
(Name (1 .. Name_Len))'Length;
|
||||
if Name_Buffer (1 .. Name_Len) =
|
||||
Name (1 .. Last - 4)
|
||||
then
|
||||
|
|
@ -772,8 +774,7 @@ package body Clean is
|
|||
(Unit.File_Names (Spec).Project) =
|
||||
Project
|
||||
then
|
||||
Get_Name_String
|
||||
(Unit.File_Names (Spec).File);
|
||||
Get_Name_String (Unit.File_Names (Spec).File);
|
||||
Name_Len :=
|
||||
Name_Len -
|
||||
File_Extension
|
||||
|
|
@ -869,7 +870,7 @@ package body Clean is
|
|||
|
||||
if Project.Object_Directory /= No_Path_Information
|
||||
and then Is_Directory
|
||||
(Get_Name_String (Project.Object_Directory.Display_Name))
|
||||
(Get_Name_String (Project.Object_Directory.Display_Name))
|
||||
then
|
||||
declare
|
||||
Obj_Dir : constant String :=
|
||||
|
|
@ -904,8 +905,9 @@ package body Clean is
|
|||
(Unit.File_Names (Impl).Project, Project))
|
||||
or else
|
||||
(Unit.File_Names (Spec) /= null
|
||||
and then In_Extension_Chain
|
||||
(Unit.File_Names (Spec).Project, Project))
|
||||
and then
|
||||
In_Extension_Chain
|
||||
(Unit.File_Names (Spec).Project, Project))
|
||||
then
|
||||
if Unit.File_Names (Impl) /= null then
|
||||
File_Name1 := Unit.File_Names (Impl).File;
|
||||
|
|
@ -942,17 +944,17 @@ package body Clean is
|
|||
|
||||
declare
|
||||
Asm : constant String :=
|
||||
Assembly_File_Name (Lib_File);
|
||||
Assembly_File_Name (Lib_File);
|
||||
ALI : constant String :=
|
||||
ALI_File_Name (Lib_File);
|
||||
ALI_File_Name (Lib_File);
|
||||
Obj : constant String :=
|
||||
Object_File_Name (Lib_File);
|
||||
Object_File_Name (Lib_File);
|
||||
Adt : constant String :=
|
||||
Tree_File_Name (Lib_File);
|
||||
Tree_File_Name (Lib_File);
|
||||
Deb : constant String :=
|
||||
Debug_File_Name (File_Name1);
|
||||
Debug_File_Name (File_Name1);
|
||||
Rep : constant String :=
|
||||
Repinfo_File_Name (File_Name1);
|
||||
Repinfo_File_Name (File_Name1);
|
||||
Del : Boolean := True;
|
||||
|
||||
begin
|
||||
|
|
@ -1199,8 +1201,9 @@ package body Clean is
|
|||
end if;
|
||||
|
||||
if Project.Object_Directory /= No_Path_Information
|
||||
and then Is_Directory
|
||||
(Get_Name_String (Project.Object_Directory.Display_Name))
|
||||
and then
|
||||
Is_Directory
|
||||
(Get_Name_String (Project.Object_Directory.Display_Name))
|
||||
then
|
||||
Delete_Binder_Generated_Files
|
||||
(Get_Name_String (Project.Object_Directory.Display_Name),
|
||||
|
|
@ -1811,8 +1814,7 @@ package body Clean is
|
|||
declare
|
||||
Prj : constant String := Arg (3 .. Arg'Last);
|
||||
begin
|
||||
if Prj'Length > 1 and then
|
||||
Prj (Prj'First) = '='
|
||||
if Prj'Length > 1 and then Prj (Prj'First) = '='
|
||||
then
|
||||
Project_File_Name :=
|
||||
new String'
|
||||
|
|
|
|||
|
|
@ -224,7 +224,7 @@ package Opt is
|
|||
-- GNAT Normally, in accordance with (RM 13.9.1 (9-11)) the front end
|
||||
-- assumes that values could have invalid representations, unless it can
|
||||
-- clearly prove that the values are valid. If this switch is set (by
|
||||
-- pragma Assume_No_Invalid_Values (Off)), then the compiler assumes values
|
||||
-- pragma Assume_No_Invalid_Values (On)), then the compiler assumes values
|
||||
-- are valid and in range of their representations. This feature is now
|
||||
-- fully enabled in the compiler.
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue