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
-- 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
-- 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
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;
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
return;
end if;
- Test_Style_Warning_Serious_Msg (Msg);
+ Test_Style_Warning_Serious_Unconditional_Msg (Msg);
-- Special handling for warning messages
-- 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)
begin
Manual_Quote_Mode := False;
- Is_Unconditional_Msg := False;
Msglen := 0;
Flag_Source := Get_Source_File_Index (Flag);
Set_Msg_Char ('"');
when '!' =>
- Is_Unconditional_Msg := True;
+ null; -- already dealt with
when '?' =>
Set_Msg_Insertion_Warning;
-- 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 --
-- 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
-- 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
-- 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) /= ''')
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
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 --
-- --
-- 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- --
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
-- 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
-- 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
-- --
-- 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- --
-- 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
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
------------------
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;
Set_Msg_Char ('"');
elsif C = '!' then
- Is_Unconditional_Msg := True;
+ null;
elsif C = '?' then
null;
@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
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}
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
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.
-- 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)));
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
projects / platform / upstream / gcc.git / commitdiff