diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3fac0296dbb..773cf44c266 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2014-07-30 Thomas Quinot + + * gnat_rm.texi: Minor doc fixes. + +2014-07-30 Robert Dewar + + * a-rbtgbo.adb, sem_ch13.adb: Minor reformatting. + +2014-07-30 Vincent Celier + + * 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 * a-crdlli.ads: Place declaration of Empty_List after full type @@ -17,7 +34,7 @@ 2014-07-30 Ed Schonberg - * 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. diff --git a/gcc/ada/a-rbtgbo.adb b/gcc/ada/a-rbtgbo.adb index d3b54d64695..99a2edc2e36 100644 --- a/gcc/ada/a-rbtgbo.adb +++ b/gcc/ada/a-rbtgbo.adb @@ -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; diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb index f15eec9a7b1..b6d6b92b015 100644 --- a/gcc/ada/errutil.adb +++ b/gcc/ada/errutil.adb @@ -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 diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index edbba0f2a7b..c8d544a337e 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -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 + +@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 - -@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, diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index c975e1981b8..9bc7e1dea99 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -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; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 614329914e5..5a5afa5b2e8 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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);