From fd436512a2cf3cae812662b98f625c7062217823 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 8 Jul 2013 08:05:45 +0000 Subject: 2013-07-08 Robert Dewar * gnatcmd.adb: Minor reformatting. 2013-07-08 Robert Dewar * targparm.adb (Get_Target_Parameters): Recognize pragma Partition_Elaboration_Policy. 2013-07-08 Robert Dewar * gnat_ugn.texi: Minor update to mention partition elaboration policy. 2013-07-08 Ed Schonberg * sem_ch4.adb (Comple_Object_Operation): Revert previous change. (Analyze_Indexed_Component_Form): In ASIS mode, if node has been transformed but not rewritten as a function call (as is the case in a generic), analyze it as such. 2013-07-08 Thomas Quinot * gnat_rm.texi: Minor rewording: add missing word "operators" in documentation for restriction No_Direct_Boolean_Operator. 2013-07-08 Robert Dewar * errout.adb (Set_Msg_Txt): No longer sets Is_Style_Msg, Is_Warning_Msg, or Is_Unconditional_Msg (all are set elsewhere now). * errout.ads: Insertions ! and !! no longer have to be at the end of the message, they can be anywhere in the message. * erroutc.adb (Test_Style_Warning_Serious_Unconditional_Msg): Replaces Test_Style_Warning_Serious_Msg * erroutc.ads (Has_Double_Exclam): New flag New comments for existing flags (Test_Style_Warning_Serious_Unconditional_Msg): Replaces Test_Style_Warning_Serious_Msg * errutil.adb (Test_Style_Warning_Serious_Unconditional_Msg): Replaces Test_Style_Warning_Serious_Msg git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@200765 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 40 ++++++++++++++++++++++++++++++++++++++++ gcc/ada/errout.adb | 18 ++++++++---------- gcc/ada/errout.ads | 11 +++++------ gcc/ada/erroutc.adb | 28 ++++++++++++++++++++-------- gcc/ada/erroutc.ads | 50 ++++++++++++++++++++++++++++++++++---------------- gcc/ada/errutil.adb | 16 ++++++++-------- gcc/ada/gnat_rm.texi | 10 +++++----- gcc/ada/gnat_ugn.texi | 1 + gcc/ada/gnatcmd.adb | 10 +++++----- gcc/ada/sem_ch4.adb | 16 ++++++++++++++-- gcc/ada/targparm.adb | 10 ++++++++++ 11 files changed, 150 insertions(+), 60 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8810c253f81..ab8ce39b928 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,43 @@ +2013-07-08 Robert Dewar + + * gnatcmd.adb: Minor reformatting. + +2013-07-08 Robert Dewar + + * targparm.adb (Get_Target_Parameters): Recognize pragma + Partition_Elaboration_Policy. + +2013-07-08 Robert Dewar + + * gnat_ugn.texi: Minor update to mention partition elaboration policy. + +2013-07-08 Ed Schonberg + + * sem_ch4.adb (Comple_Object_Operation): Revert previous change. + (Analyze_Indexed_Component_Form): In ASIS mode, if node has been + transformed but not rewritten as a function call (as is the case + in a generic), analyze it as such. + +2013-07-08 Thomas Quinot + + * gnat_rm.texi: Minor rewording: add missing word "operators" + in documentation for restriction No_Direct_Boolean_Operator. + +2013-07-08 Robert Dewar + + * errout.adb (Set_Msg_Txt): No longer sets Is_Style_Msg, + Is_Warning_Msg, or Is_Unconditional_Msg (all are set elsewhere + now). + * errout.ads: Insertions ! and !! no longer have to be at the + end of the message, they can be anywhere in the message. + * erroutc.adb (Test_Style_Warning_Serious_Unconditional_Msg): + Replaces Test_Style_Warning_Serious_Msg + * erroutc.ads (Has_Double_Exclam): New flag New comments for + existing flags (Test_Style_Warning_Serious_Unconditional_Msg): + Replaces Test_Style_Warning_Serious_Msg + * errutil.adb (Test_Style_Warning_Serious_Unconditional_Msg): + Replaces Test_Style_Warning_Serious_Msg + 2013-07-08 Robert Dewar * par-prag.adb (Process_Restrictions_Or_Restriction_Warnings): diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index b8d044e3d34..5e3e72381fd 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -153,8 +153,7 @@ package body Errout is -- be one of the special insertion characters (see documentation in spec). -- Flag is the location at which the error is to be posted, which is used -- to determine whether or not the # insertion needs a file name. The - -- variables Msg_Buffer, Msglen, Is_Style_Msg, Is_Warning_Msg, and - -- Is_Unconditional_Msg are set on return. + -- variables Msg_Buffer are set on return Msglen. procedure Set_Posted (N : Node_Id); -- Sets the Error_Posted flag on the given node, and all its parents @@ -283,7 +282,7 @@ package body Errout is -- Start of processing for new message Sindex := Get_Source_File_Index (Flag_Location); - Test_Style_Warning_Serious_Msg (Msg); + Test_Style_Warning_Serious_Unconditional_Msg (Msg); Orig_Loc := Original_Location (Flag_Location); -- If the current location is in an instantiation, the issue arises of @@ -726,7 +725,7 @@ package body Errout is if Suppress_Message and then not All_Errors_Mode and then not Is_Warning_Msg - and then Msg (Msg'Last) /= '!' + and then not Is_Unconditional_Msg then if not Continuation then Last_Killed := True; @@ -787,9 +786,9 @@ package body Errout is elsif Debug_Flag_GG then null; - -- Keep warning if message text ends in !! + -- Keep warning if message text contains !! - elsif Msg (Msg'Last) = '!' and then Msg (Msg'Last - 1) = '!' then + elsif Has_Double_Exclam then null; -- Here is where we delete a warning from a with'ed unit @@ -1123,7 +1122,7 @@ package body Errout is return; end if; - Test_Style_Warning_Serious_Msg (Msg); + Test_Style_Warning_Serious_Unconditional_Msg (Msg); -- Special handling for warning messages @@ -1163,7 +1162,7 @@ package body Errout is -- Test for message to be output if All_Errors_Mode - or else Msg (Msg'Last) = '!' + or else Is_Unconditional_Msg or else Is_Warning_Msg or else OK_Node (N) or else (Msg (Msg'First) = '\' and then not Last_Killed) @@ -2711,7 +2710,6 @@ package body Errout is begin Manual_Quote_Mode := False; - Is_Unconditional_Msg := False; Msglen := 0; Flag_Source := Get_Source_File_Index (Flag); @@ -2776,7 +2774,7 @@ package body Errout is Set_Msg_Char ('"'); when '!' => - Is_Unconditional_Msg := True; + null; -- already dealt with when '?' => Set_Msg_Insertion_Warning; diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 4b30a0663a0..9afc4dfd34a 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -101,10 +101,9 @@ package Errout is -- messages. Warning messages are only suppressed for case 1, and -- when they come from other than the main extended unit. - -- This normal suppression action may be overridden in cases 2-5 (but not - -- in case 1) by setting All_Errors mode, or by setting the special - -- unconditional message insertion character (!) at the end of the message - -- text as described below. + -- This normal suppression action may be overridden in cases 2-5 (but + -- not in case 1) by setting All_Errors mode, or by setting the special + -- unconditional message insertion character (!) as described below. --------------------------------------------------------- -- Error Message Text and Message Insertion Characters -- @@ -230,7 +229,7 @@ package Errout is -- name is defined, this insertion character has no effect. -- Insertion character ! (Exclamation: unconditional message) - -- The character ! appearing as the last character of a message makes + -- The character ! appearing anywhere in the text of a message makes -- the message unconditional which means that it is output even if it -- would normally be suppressed. See section above for a description -- of the cases in which messages are normally suppressed. Note that @@ -249,7 +248,7 @@ package Errout is -- Insertion character !! (Double exclamation: unconditional warning) -- Normally warning messages issued in other than the main unit are - -- suppressed. If the message ends with !! then this suppression is + -- suppressed. If the message contains !! then this suppression is -- avoided. This is currently used by the Compile_Time_Warning pragma -- to ensure the message for a with'ed unit is output, and for warnings -- on ineffective back-end inlining, which is detected in units that diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index a0da2304bc4..97ce9d77891 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -1226,22 +1226,24 @@ package body Erroutc is -- Test_Style_Warning_Serious_Msg -- ------------------------------------ - procedure Test_Style_Warning_Serious_Msg (Msg : String) is + procedure Test_Style_Warning_Serious_Unconditional_Msg (Msg : String) is begin + -- Nothing to do for continuation line + if Msg (Msg'First) = '\' then return; end if; - Is_Serious_Error := True; - Is_Warning_Msg := False; + -- Set initial values of globals (may be changed during scan) + + Is_Serious_Error := True; + Is_Unconditional_Msg := False; + Is_Warning_Msg := False; + Has_Double_Exclam := False; Is_Style_Msg := (Msg'Length > 7 and then Msg (Msg'First .. Msg'First + 6) = "(style)"); - if Is_Style_Msg then - Is_Serious_Error := False; - end if; - for J in Msg'Range loop if Msg (J) = '?' and then (J = Msg'First or else Msg (J - 1) /= ''') @@ -1249,6 +1251,16 @@ package body Erroutc is Is_Warning_Msg := True; Warning_Msg_Char := ' '; + elsif Msg (J) = '!' + and then (J = Msg'First or else Msg (J - 1) /= ''') + then + Is_Unconditional_Msg := True; + Warning_Msg_Char := ' '; + + if J < Msg'Last and then Msg (J + 1) = '!' then + Has_Double_Exclam := True; + end if; + elsif Msg (J) = '<' and then (J = Msg'First or else Msg (J - 1) /= ''') then @@ -1265,7 +1277,7 @@ package body Erroutc is if Is_Warning_Msg or Is_Style_Msg then Is_Serious_Error := False; end if; - end Test_Style_Warning_Serious_Msg; + end Test_Style_Warning_Serious_Unconditional_Msg; -------------------------------- -- Validate_Specific_Warnings -- diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads index 4e38fbd30fb..02101852d44 100644 --- a/gcc/ada/erroutc.ads +++ b/gcc/ada/erroutc.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -47,8 +47,20 @@ package Erroutc is Flag_Source : Source_File_Index; -- Source file index for source file where error is being posted + Has_Double_Exclam : Boolean := False; + -- Set true to indicate that the current message contains the insertion + -- sequence !! (force warnings even in non-main unit source files). + + Is_Serious_Error : Boolean := False; + -- Set True for a serious error (i.e. any message that is not a warning + -- or style message, and that does not contain a | insertion character). + + Is_Unconditional_Msg : Boolean := False; + -- Set True to indicate that the current message contains the insertion + -- character ! and is thus to be treated as an unconditional message. + Is_Warning_Msg : Boolean := False; - -- Set True to indicate if current message is warning message + -- Set True to indicate if current message is warning message (contains ?) Warning_Msg_Char : Character; -- Warning character, valid only if Is_Warning_Msg is True @@ -61,12 +73,6 @@ package Erroutc is -- Set True to indicate if the current message is a style message -- (i.e. a message whose text starts with the characters "(style)"). - Is_Serious_Error : Boolean := False; - -- Set by Set_Msg_Text to indicate if current message is serious error - - Is_Unconditional_Msg : Boolean := False; - -- Set by Set_Msg_Text to indicate if current message is unconditional - Kill_Message : Boolean := False; -- A flag used to kill weird messages (e.g. those containing uninterpreted -- implicit type references) if we have already seen at least one message @@ -490,14 +496,26 @@ package Erroutc is -- Called in response to a pragma Warnings (On) to record the source -- location from which warnings are to be turned back on. - procedure Test_Style_Warning_Serious_Msg (Msg : String); - -- Sets Is_Warning_Msg true if Msg is a warning message (contains a - -- question mark character), and False otherwise. Is_Style_Msg is set true - -- if Msg is a style message (starts with "(style)". Sets Is_Serious_Error - -- True unless the message is a warning or style/info message or contains - -- the character | indicating a non-serious error message. Note that the - -- call has no effect for continuation messages (those whose first - -- character is '\'). + procedure Test_Style_Warning_Serious_Unconditional_Msg (Msg : String); + -- Scans message text and sets the following variables: + -- + -- Is_Warning_Msg is set True if Msg is a warning message (contains a + -- question mark character), and False otherwise. + -- + -- Is_Style_Msg is set True if Msg is a style message (starts with + -- "(style)") and False otherwise. + -- + -- Is_Serious_Error is set to True unless the message is a warning or + -- style message or contains the character | (non-serious error). + -- + -- Is_Unconditional_Msg is set True if the message contains the character + -- ! and is otherwise set False. + -- + -- Has_Double_Exclam is set True if the message contains the sequence !! + -- and is otherwise set False. + -- + -- Note that the call has no effect for continuation messages (those whose + -- first character is '\'), and all variables are left unchanged. function Warnings_Suppressed (Loc : Source_Ptr) return Boolean; -- Determines if given location is covered by a warnings off suppression diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb index 3a087caac66..b79ea027f50 100644 --- a/gcc/ada/errutil.adb +++ b/gcc/ada/errutil.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1991-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2013, 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- -- @@ -163,9 +163,9 @@ package body Errutil is -- Corresponds to the Sptr value in the error message object Optr : Source_Ptr renames Flag_Location; - -- Corresponds to the Optr value in the error message object. Note - -- that for this usage, Sptr and Optr always have the same value, - -- since we do not have to worry about generic instantiations. + -- Corresponds to the Optr value in the error message object. Note that + -- for this usage, Sptr and Optr always have the same value, since we do + -- not have to worry about generic instantiations. begin if Errors_Must_Be_Ignored then @@ -176,7 +176,7 @@ package body Errutil is raise Error_Msg_Exception; end if; - Test_Style_Warning_Serious_Msg (Msg); + Test_Style_Warning_Serious_Unconditional_Msg (Msg); Set_Msg_Text (Msg, Sptr); -- Kill continuation if parent message killed @@ -680,8 +680,8 @@ package body Errutil is ------------------ procedure Set_Msg_Text (Text : String; Flag : Source_Ptr) is - C : Character; -- Current character - P : Natural; -- Current index; + C : Character; -- Current character + P : Natural; -- Current index; begin Manual_Quote_Mode := False; @@ -744,7 +744,7 @@ package body Errutil is Set_Msg_Char ('"'); elsif C = '!' then - Is_Unconditional_Msg := True; + null; elsif C = '?' then null; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index b714e25899a..89db1172d2b 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -9066,11 +9066,11 @@ dependence on a library unit. @node No_Direct_Boolean_Operators @unnumberedsubsec No_Direct_Boolean_Operators @findex No_Direct_Boolean_Operators -[GNAT] This restriction ensures that no logical (and/or/xor) are used on -operands of type Boolean (or any type derived -from Boolean). This is intended for use in safety critical programs -where the certification protocol requires the use of short-circuit -(and then, or else) forms for all composite boolean operations. +[GNAT] This restriction ensures that no logical operators (and/or/xor) +are used on operands of type Boolean (or any type derived from Boolean). +This is intended for use in safety critical programs where the certification +protocol requires the use of short-circuit (and then, or else) forms for all +composite boolean operations. @node No_Dispatch @unnumberedsubsec No_Dispatch diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 86eb6b3a711..4099ace5c67 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -17251,6 +17251,7 @@ The pragmas listed below should be used with caution inside libraries, as they can create incompatibilities with other Ada libraries: @itemize @bullet @item pragma @code{Locking_Policy} +@item pragma @code{Partition_Elaboration_Policy} @item pragma @code{Queuing_Policy} @item pragma @code{Task_Dispatching_Policy} @item pragma @code{Unreserve_All_Interrupts} diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index d1ea2be3e04..d879cb7813a 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -406,14 +406,14 @@ procedure GNATCmd is end if; end loop; - -- If all arguments are switches and there is no switch -files=, add - -- the path names of all the sources of the main project. + -- If all arguments are switches and there is no switch -files=, add the + -- path names of all the sources of the main project. if Add_Sources then - -- For gnatcheck, gnatpp, and gnatmetric, create a temporary file - -- and put the list of sources in it. For gnatstack create a - -- temporary file with the list of .ci files. + -- For gnatcheck, gnatpp, and gnatmetric, create a temporary file and + -- put the list of sources in it. For gnatstack create a temporary + -- file with the list of .ci files. if The_Command = Check or else The_Command = Pretty or else diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 1459ec22f95..333fb4bd397 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -2472,10 +2472,22 @@ package body Sem_Ch4 is Process_Function_Call; elsif Nkind (P) = N_Selected_Component + and then Present (Entity (Selector_Name (P))) and then Is_Overloadable (Entity (Selector_Name (P))) then Process_Function_Call; + -- In ASIS mode within a generic, a prefixed call is analyzed and + -- partially rewritten but the original indexed component has not + -- yet been rewritten as a call. Perform the replacement now. + + elsif Nkind (P) = N_Selected_Component + and then Nkind (Parent (P)) = N_Function_Call + and then ASIS_Mode + then + Rewrite (N, Parent (P)); + Analyze (N); + else -- Indexed component, slice, or a call to a member of a family -- entry, which will be converted to an entry call later. @@ -7202,13 +7214,13 @@ package body Sem_Ch4 is -- though they may be overwritten during resolution if overloaded. -- Perform the same transformation in ASIS mode, because during -- pre-analysis of a pre/post condition the node will not be - -- rewritten as a call. + -- rewritten as a call. (is this ASIS comment obsolete ???) Set_Comes_From_Source (Subprog, Comes_From_Source (N)); Set_Comes_From_Source (Call_Node, Comes_From_Source (N)); if Nkind (N) = N_Selected_Component - and then (not Inside_A_Generic or ASIS_Mode) + and then not Inside_A_Generic then Set_Entity (Selector_Name (N), Entity (Subprog)); Set_Etype (Selector_Name (N), Etype (Entity (Subprog))); diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index ce3da1cb737..37ac4cd25f9 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -388,6 +388,16 @@ package body Targparm is Opt.Init_Or_Norm_Scalars := True; goto Line_Loop_Continue; + -- Partition_Elaboration_Policy + + elsif System_Text (P .. P + 36) = + "pragma Partition_Elaboration_Policy (" + then + P := P + 37; + Opt.Partition_Elaboration_Policy := System_Text (P); + Opt.Partition_Elaboration_Policy_Sloc := System_Location; + goto Line_Loop_Continue; + -- Polling (On) elsif System_Text (P .. P + 19) = "pragma Polling (On);" then -- cgit v1.2.3