+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
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.
-- 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)
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))));
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);
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);
"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;
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));
-----------------
procedure Left_Rotate (Tree : in out Tree_Type'Class; X : Count_Type) is
+
-- CLR p. 266
N : Nodes_Type renames Tree.Nodes;
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;
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;
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;
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
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}.
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,
when Use_Error =>
Error_Msg
(Data.Flags,
- "could not create " & Create &
+ "~could not create " & Create &
" directory " & Full_Path_Name.all,
Location, Project);
end;
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);