2013-07-08 Robert Dewar <dewar@adacore.com>

	* gnatcmd.adb: Minor reformatting.

2013-07-08  Robert Dewar  <dewar@adacore.com>

	* targparm.adb (Get_Target_Parameters): Recognize pragma
	Partition_Elaboration_Policy.

2013-07-08  Robert Dewar  <dewar@adacore.com>

	* gnat_ugn.texi: Minor update to mention partition elaboration policy.

2013-07-08  Ed Schonberg  <schonberg@adacore.com>

	* 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  <quinot@adacore.com>

	* gnat_rm.texi: Minor rewording: add missing word "operators"
	in documentation for restriction No_Direct_Boolean_Operator.

2013-07-08  Robert Dewar  <dewar@adacore.com>

	* 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

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,5 +1,45 @@
 2013-07-08  Robert Dewar  <dewar@adacore.com>
 
+	* gnatcmd.adb: Minor reformatting.
+
+2013-07-08  Robert Dewar  <dewar@adacore.com>
+
+	* targparm.adb (Get_Target_Parameters): Recognize pragma
+	Partition_Elaboration_Policy.
+
+2013-07-08  Robert Dewar  <dewar@adacore.com>
+
+	* gnat_ugn.texi: Minor update to mention partition elaboration policy.
+
+2013-07-08  Ed Schonberg  <schonberg@adacore.com>
+
+	* 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  <quinot@adacore.com>
+
+	* gnat_rm.texi: Minor rewording: add missing word "operators"
+	in documentation for restriction No_Direct_Boolean_Operator.
+
+2013-07-08  Robert Dewar  <dewar@adacore.com>
+
+	* 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  <dewar@adacore.com>
+
 	* par-prag.adb (Process_Restrictions_Or_Restriction_Warnings):
 	Recognize SPARK_05 as synonym for SPARK in restrictions pragma.
 	* restrict.ads, restrict.adb (SPARK_Hides): Table moved to body, only
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