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

[multiple changes]

Browse Source 
2014-07-30  Thomas Quinot  <quinot@adacore.com>

	* gnat_rm.texi: Minor doc fixes.

2014-07-30  Robert Dewar  <dewar@adacore.com>

	* a-rbtgbo.adb, sem_ch13.adb: Minor reformatting.

2014-07-30  Vincent Celier  <celier@adacore.com>

	* errutil.adb (Set_Msg_Text): Process tilde ('~'): no processing
	of error message.
	* prj-nmsc.adb (Locate_Directory): Use a tilde ('~') in the
	message to report that a directory cannot be created, to avoid
	processing of the directory path that may contains special
	insertion characters.

From-SVN: r213301
This commit is contained in:
Arnaud Charlet 2014-07-30 17:19:17 +02:00
parent a18e3d6279
commit 0be7dcbbdb
6 changed files with 53 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/ada/ChangeLog
View File

@ -1,3 +1,20 @@
2014-07-30 Thomas Quinot <quinot@adacore.com>
* gnat_rm.texi: Minor doc fixes.
2014-07-30 Robert Dewar <dewar@adacore.com>
* a-rbtgbo.adb, sem_ch13.adb: Minor reformatting.
2014-07-30 Vincent Celier <celier@adacore.com>
* errutil.adb (Set_Msg_Text): Process tilde ('~'): no processing
of error message.
* prj-nmsc.adb (Locate_Directory): Use a tilde ('~') in the
message to report that a directory cannot be created, to avoid
processing of the directory path that may contains special
insertion characters.
2014-07-30 Ed Schonberg <schonberg@adacore.com>
* a-crdlli.ads: Place declaration of Empty_List after full type
@ -17,7 +34,7 @@
2014-07-30 Ed Schonberg <schonberg@adacore.com>
* a-rbtgbo.adb: -rbtgbo.adb (Delete_Node_Sans_Free): If
* a-rbtgbo.adb (Delete_Node_Sans_Free): If
element is not present in tree return rather than violating
an assertion. Constraint_Error will be raised in the caller if
element is not in the container.

44
gcc/ada/a-rbtgbo.adb
View File

@ -27,8 +27,9 @@
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
-- The references below to "CLR" refer to the following book, from which
-- several of the algorithms here were adapted:
-- The references in this file to "CLR" refer to the following book, from
-- which several of the algorithms here were adapted:
-- Introduction to Algorithms
-- by Thomas H. Cormen, Charles E. Leiserson, Ronald L. Rivest
-- Publisher: The MIT Press (June 18, 1990)
@ -89,9 +90,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
begin
X := Node;
while X /= Tree.Root
and then Color (N (X)) = Black
loop
while X /= Tree.Root and then Color (N (X)) = Black loop
if X = Left (N (Parent (N (X)))) then
W := Right (N (Parent (N (X))));
@ -103,7 +102,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
end if;
if (Left (N (W)) = 0 or else Color (N (Left (N (W)))) = Black)
and then
and then
(Right (N (W)) = 0 or else Color (N (Right (N (W)))) = Black)
then
Set_Color (N (W), Red);
@ -147,7 +146,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
end if;
if (Left (N (W)) = 0 or else Color (N (Left (N (W)))) = Black)
and then
and then
(Right (N (W)) = 0 or else Color (N (Right (N (W)))) = Black)
then
Set_Color (N (W), Red);
@ -205,7 +204,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
"attempt to tamper with cursors (container is busy)";
end if;
-- If node is not present, return. Exception will be raised in caller.
-- If node is not present, return (exception will be raised in caller)
if Z = 0 then
return;
@ -218,8 +217,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
pragma Assert (Parent (N (Tree.Root)) = 0);
pragma Assert ((Tree.Length > 1)
or else (Tree.First = Tree.Last
and then Tree.First = Tree.Root));
or else (Tree.First = Tree.Last
and then Tree.First = Tree.Root));
pragma Assert ((Left (N (Node)) = 0)
or else (Parent (N (Left (N (Node)))) = Node));
@ -826,6 +825,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
-----------------
procedure Left_Rotate (Tree : in out Tree_Type'Class; X : Count_Type) is
-- CLR p. 266
N : Nodes_Type renames Tree.Nodes;
@ -929,9 +929,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
Y : Count_Type := Parent (Tree.Nodes (Node));
begin
while Y /= 0
and then X = Right (Tree.Nodes (Y))
loop
while Y /= 0 and then X = Right (Tree.Nodes (Y)) loop
X := Y;
Y := Parent (Tree.Nodes (Y));
end loop;
@ -962,9 +960,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
Y : Count_Type := Parent (Tree.Nodes (Node));
begin
while Y /= 0
and then X = Left (Tree.Nodes (Y))
loop
while Y /= 0 and then X = Left (Tree.Nodes (Y)) loop
X := Y;
Y := Parent (Tree.Nodes (Y));
end loop;
@ -1135,28 +1131,20 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
end if;
if Tree.Length = 2 then
if Tree.First /= Tree.Root
and then Tree.Last /= Tree.Root
then
if Tree.First /= Tree.Root and then Tree.Last /= Tree.Root then
return False;
end if;
if Tree.First /= Index
and then Tree.Last /= Index
then
if Tree.First /= Index and then Tree.Last /= Index then
return False;
end if;
end if;
if Left (Node) /= 0
and then Parent (Nodes (Left (Node))) /= Index
then
if Left (Node) /= 0 and then Parent (Nodes (Left (Node))) /= Index then
return False;
end if;
if Right (Node) /= 0
and then Parent (Nodes (Right (Node))) /= Index
then
if Right (Node) /= 0 and then Parent (Nodes (Right (Node))) /= Index then
return False;
end if;

9
gcc/ada/errutil.adb
View File

@ -772,6 +772,15 @@ package body Errutil is
P := P - 1;
Set_Msg_Insertion_Reserved_Word (Text, P);
-- Tilde: just remove '~' and do not modify the message further
-- This is peculiar, incompatible with errout, and not documented ???
elsif C = '~' then
Set_Msg_Str
(Text (Text'First .. P - 2) & Text (P .. Text'Last));
exit;
-- Normal character with no special treatment
else

16
gcc/ada/gnat_rm.texi
View File

@ -1566,12 +1566,12 @@ useful when the pragma or aspect argument references subprograms
in a with'ed package which is replaced by a dummy package
for the final build.
The implementation defined policy @code{Assertions} applies to all
The implementation defined assertion kind @code{Assertions} applies to all
assertion kinds. The form with no assertion kind given implies this
choice, so it applies to all assertion kinds (RM defined, and
implementation defined).
The implementation defined policy @code{Statement_Assertions}
The implementation defined assertion kind @code{Statement_Assertions}
applies to @code{Assert}, @code{Assert_And_Cut},
@code{Assume}, @code{Loop_Invariant}, and @code{Loop_Variant}.
@ -11111,16 +11111,16 @@ type @code{Character}).
forbidden in SPARK 2005 are not present. Error messages related to
SPARK restriction have the form:
@smallexample
violation of restriction "SPARK_05" at <source-location>
<error message>
@end smallexample
@findex SPARK
The restriction @code{SPARK} is recognized as a
synonym for @code{SPARK_05}. This is retained for historical
compatibility purposes (and an unconditional warning will be generated
for its use, advising replacement by @code{SPARK}.
@smallexample
violation of restriction "SPARK" at <file>
<error message>
@end smallexample
for its use, advising replacement by @code{SPARK}).
This is not a replacement for the semantic checks performed by the
SPARK Examiner tool, as the compiler currently only deals with code,

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

@ -6214,7 +6214,7 @@ package body Prj.Nmsc is
when Use_Error =>
Error_Msg
(Data.Flags,
"could not create " & Create &
"~could not create " & Create &
" directory " & Full_Path_Name.all,
Location, Project);
end;

3
gcc/ada/sem_ch13.adb
View File

@ -2633,8 +2633,7 @@ package body Sem_Ch13 is
when Aspect_Default_Component_Value =>
if not (Is_Array_Type (E)
and then
Is_Scalar_Type (Component_Type (E)))
and then Is_Scalar_Type (Component_Type (E)))
then
Error_Msg_N ("aspect Default_Component_Value can only "
& "apply to an array of scalar components", N);