From 02f588343104177827aeb428ea9fca6e55910ef3 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 12 Jun 2012 12:33:06 +0200 Subject: [PATCH] [multiple changes] 2012-06-12 Robert Dewar * a-direct.adb: Minor reformatting. 2012-06-12 Robert Dewar * gnat_ugn.texi: Add missing documentation for -gnatw.v and -gnatw.V. 2012-06-12 Thomas Quinot * sem_ch7.adb, sem_prag.adb, sem_ch12.adb, sem_ch4.adb, sem_ch13.adb: Minor rewording of error messages for unchecked unions. From-SVN: r188441 --- gcc/ada/ChangeLog | 14 ++++++++++++++ gcc/ada/a-direct.adb | 40 ++++++++++++++++++---------------------- gcc/ada/gnat_ugn.texi | 18 ++++++++++++++++++ gcc/ada/sem_ch12.adb | 2 +- gcc/ada/sem_ch13.adb | 2 +- gcc/ada/sem_ch4.adb | 2 +- gcc/ada/sem_ch7.adb | 12 +++++------- gcc/ada/sem_prag.adb | 16 ++++++++-------- 8 files changed, 66 insertions(+), 40 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d65c794dd1b..4f6782225e9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2012-06-12 Robert Dewar + + * a-direct.adb: Minor reformatting. + +2012-06-12 Robert Dewar + + * gnat_ugn.texi: Add missing documentation for -gnatw.v and + -gnatw.V. + +2012-06-12 Thomas Quinot + + * sem_ch7.adb, sem_prag.adb, sem_ch12.adb, sem_ch4.adb, + sem_ch13.adb: Minor rewording of error messages for unchecked unions. + 2012-06-12 Robert Dewar * lib-xref.ads: Minor reformatting. diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb index 61de3237cd9..cac87afcbfe 100644 --- a/gcc/ada/a-direct.adb +++ b/gcc/ada/a-direct.adb @@ -56,6 +56,7 @@ package body Ada.Directories is -- opendir routine. No_Dir : constant Dir_Type_Value := Dir_Type_Value (Null_Address); + -- Null directory value Dir_Separator : constant Character; pragma Import (C, Dir_Separator, "__gnat_dir_separator"); @@ -232,13 +233,14 @@ package body Ada.Directories is elsif Norm = "/" or else (Windows - and then - (Norm = "\" - or else - (Norm'Length = 3 - and then Norm (Norm'Last - 1 .. Norm'Last) = ":\" - and then (Norm (Norm'First) in 'a' .. 'z' - or else Norm (Norm'First) in 'A' .. 'Z')))) + and then + (Norm = "\" + or else + (Norm'Length = 3 + and then Norm (Norm'Last - 1 .. Norm'Last) = ":\" + and then (Norm (Norm'First) in 'a' .. 'z' + or else + Norm (Norm'First) in 'A' .. 'Z')))) then raise Use_Error with "directory """ & Name & """ has no containing directory"; @@ -349,16 +351,12 @@ package body Ada.Directories is if V1 = 0 then Mode := Overwrite; - elsif Formstr (V1 .. V2) = "copy" then Mode := Copy; - elsif Formstr (V1 .. V2) = "overwrite" then Mode := Overwrite; - elsif Formstr (V1 .. V2) = "append" then Mode := Append; - else raise Use_Error with "invalid Form"; end if; @@ -367,16 +365,12 @@ package body Ada.Directories is if V1 = 0 then Preserve := None; - elsif Formstr (V1 .. V2) = "timestamps" then Preserve := Time_Stamps; - elsif Formstr (V1 .. V2) = "all_attributes" then Preserve := Full; - elsif Formstr (V1 .. V2) = "no_attributes" then Preserve := None; - else raise Use_Error with "invalid Form"; end if; @@ -535,10 +529,11 @@ package body Ada.Directories is elsif not Is_Directory (Directory) then raise Name_Error with '"' & Directory & """ not a directory"; + -- Do the deletion, checking for error + else declare C_Dir_Name : constant String := Directory & ASCII.NUL; - begin if rmdir (C_Dir_Name) /= 0 then raise Use_Error with @@ -597,8 +592,8 @@ package body Ada.Directories is else Set_Directory (Directory); - Start_Search (Search, Directory => ".", Pattern => ""); + Start_Search (Search, Directory => ".", Pattern => ""); while More_Entries (Search) loop Get_Next_Entry (Search, Dir_Ent); @@ -849,8 +844,8 @@ package body Ada.Directories is -- Use System.OS_Lib.Normalize_Pathname declare - -- We need to resolve links because of A.16(47), since we must not - -- return alternative names for files. + -- We need to resolve links because of (RM A.16(47)), which says + -- we must not return alternative names for files. Value : constant String := Normalize_Pathname (Name); subtype Result is String (1 .. Value'Length); @@ -920,6 +915,8 @@ package body Ada.Directories is if not File_Exists (Name) then raise Name_Error with "file """ & Name & """ does not exist"; + -- If OK, return appropriate kind + elsif Is_Regular_File (Name) then return Ordinary_File; @@ -1059,9 +1056,9 @@ package body Ada.Directories is "new name """ & New_Name & """ designates a file that already exists"; - else - -- Do actual rename using System.OS_Lib.Rename_File + -- Do actual rename using System.OS_Lib.Rename_File + else Rename_File (Old_Name, New_Name, Success); if not Success then @@ -1100,7 +1097,6 @@ package body Ada.Directories is begin Start_Search (Srch, Directory, Pattern, Filter); - while More_Entries (Srch) loop Get_Next_Entry (Srch, Directory_Entry); Process (Directory_Entry); diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 825c8a4df7a..3f02f7573d6 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -5806,6 +5806,24 @@ then the following code: will suppress warnings on subsequent statements that access components of variable Tab. +@item -gnatw.v +@emph{Activate info messages for non-default bit order.} +@cindex @option{-gnatw.v} (@command{gcc}) +@cindex bit order warnings +This switch activates messages (labeled "info", they are not warnings, +just informational messages) about the effects of non-default bit-order +on records to which a component clause is applied. The effect of specifying +non-default bit ordering is a bit subtle (and changed with Ada 2005), so +these messages, which are given by default, are useful in understanding the +exact consequences of using this feature. These messages +can also be turned on using @option{-gnatwa} + +@item -gnatw.V +@emph{Suppress info messages for non-default bit order.} +@cindex @option{-gnatw.V} (@command{gcc}) +This switch suppresses information messages for the effects of specifying +non-default bit order on record components with component clauses. + @item -gnatww @emph{Activate warnings on wrong low bound assumption.} @cindex @option{-gnatww} (@command{gcc}) diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 6f398006d58..d38d2e277dd 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -11442,7 +11442,7 @@ package body Sem_Ch12 is then null; else - Error_Msg_N ("Unchecked_Union cannot be the actual for a" & + Error_Msg_N ("unchecked union cannot be the actual for a" & " discriminated formal type", Act_T); end if; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 9acce0f163c..80781ab7bd7 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -4481,7 +4481,7 @@ package body Sem_Ch13 is and then Is_Unchecked_Union (Rectype) then Error_Msg_N - ("cannot reference discriminant of Unchecked_Union", + ("cannot reference discriminant of unchecked union", Component_Name (CC)); elsif Present (Component_Clause (Comp)) then diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index c1e386ecbe0..f1f7c608ea3 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3891,7 +3891,7 @@ package body Sem_Ch4 is if Ekind (Comp) = E_Discriminant then if Is_Unchecked_Union (Base_Type (Prefix_Type)) then Error_Msg_N - ("cannot reference discriminant of Unchecked_Union", + ("cannot reference discriminant of unchecked union", Sel); end if; diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index e30bb0c458e..2774c2a7902 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -897,10 +897,8 @@ package body Sem_Ch7 is -- is a public child of Parent as defined in 10.1.1 procedure Inspect_Unchecked_Union_Completion (Decls : List_Id); - -- Detects all incomplete or private type declarations having a known - -- discriminant part that are completed by an Unchecked_Union. Emits - -- the error message "Unchecked_Union may not complete discriminated - -- partial view". + -- Reject completion of an incomplete or private type declarations + -- having a known discriminant part by an unchecked union. procedure Install_Parent_Private_Declarations (Inst_Id : Entity_Id); -- Given the package entity of a generic package instantiation or @@ -1091,7 +1089,7 @@ package body Sem_Ch7 is then Error_Msg_N ("completion of discriminated partial view " - & "cannot be an Unchecked_Union", + & "cannot be an unchecked union", Full_View (Defining_Identifier (Decl))); end if; @@ -1397,7 +1395,7 @@ package body Sem_Ch7 is -- Ada 2005 (AI-216): The completion of an incomplete or private type -- declaration having a known_discriminant_part shall not be an - -- Unchecked_Union type. + -- unchecked union type. if Present (Vis_Decls) then Inspect_Unchecked_Union_Completion (Vis_Decls); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 2b038fa51c9..d041ca3a5f0 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -1408,15 +1408,15 @@ package body Sem_Prag is and then Is_Generic_Type (Typ) then Error_Msg_N - ("component of Unchecked_Union cannot be of generic type", Comp); + ("component of unchecked union cannot be of generic type", Comp); elsif Needs_Finalization (Typ) then Error_Msg_N - ("component of Unchecked_Union cannot be controlled", Comp); + ("component of unchecked union cannot be controlled", Comp); elsif Has_Task (Typ) then Error_Msg_N - ("component of Unchecked_Union cannot have tasks", Comp); + ("component of unchecked union cannot have tasks", Comp); end if; end Check_Component; @@ -14164,16 +14164,16 @@ package body Sem_Prag is -- the relevant type declaration at an appropriate point. if not Is_Record_Type (Typ) then - Error_Msg_N ("Unchecked_Union must be record type", Typ); + Error_Msg_N ("unchecked union must be record type", Typ); return; elsif Is_Tagged_Type (Typ) then - Error_Msg_N ("Unchecked_Union must not be tagged", Typ); + Error_Msg_N ("unchecked union must not be tagged", Typ); return; elsif not Has_Discriminants (Typ) then Error_Msg_N - ("Unchecked_Union must have one discriminant", Typ); + ("unchecked union must have one discriminant", Typ); return; -- Note: in previous versions of GNAT we used to check for limited @@ -14187,7 +14187,7 @@ package body Sem_Prag is while Present (Discr) loop if No (Discriminant_Default_Value (Discr)) then Error_Msg_N - ("Unchecked_Union discriminant must have default value", + ("unchecked union discriminant must have default value", Discr); end if; @@ -14201,7 +14201,7 @@ package body Sem_Prag is if No (Clist) or else No (Variant_Part (Clist)) then Error_Msg_N - ("Unchecked_Union must have variant part", Tdef); + ("unchecked union must have variant part", Tdef); return; end if; -- 2.30.2