+2014-02-25 Eric Botcazou <ebotcazou@adacore.com>
+
+ * sigtramp-armvxw.c: Also restore r0.
+
+2014-02-25 Robert Dewar <dewar@adacore.com>
+
+ * errout.adb (Error_Msg_Internal): Warning_Msg_Char set
+ unconditionally (Set_Msg_Insertion_Warning): Warning_Msg_Char
+ set unconditionally.
+ * erroutc.adb (Get_Warning_Tag): Does not give a leading space
+ any more (Output_Msg_Text): Rewritten with new convention on
+ output of warnings that are treated as errors.
+ * erroutc.ads (Error_Msg_Object): Warn_Chr is always set even
+ if Warn is False.
+ * gnat_rm.texi: Updates to documentation on pragma
+ Warning_As_Error.
+ * warnsw.adb (Set_Dot_Warning_Switch): -gnatw.e should not
+ set Warning_Doc_Switch.
+ * lib-writ.ads: Add documentation note on ALI file generation
+ for C.
+ * exp_ch6.adb (Expand_Call): Remove check for No_Abort_Statements
+ (belongs in Sem).
+ * sem_attr.adb (Resolve_Attribute, case Access):
+ Abort_Task'Access violates the No_Abort_Statements restriction.
+ * sem_res.adb (Resolve_Call): Check restriction
+ No_Abort_Statements for call to Abort_Task or a renaming of it.
+
2014-02-25 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb (Array_Type_Declaration): Check for case of using
Continuation_New_Line := False;
Suppress_Message := False;
Kill_Message := False;
+ Warning_Msg_Char := ' ';
Set_Msg_Text (Msg, Sptr);
-- Kill continuation if parent message killed
procedure Set_Msg_Insertion_Warning (C : Character) is
begin
- Warning_Msg_Char := ' ';
-
if P <= Text'Last and then Text (P) = C then
- if Warning_Doc_Switch then
- Warning_Msg_Char := '?';
- end if;
-
+ Warning_Msg_Char := '?';
P := P + 1;
elsif P + 1 <= Text'Last
and then (Text (P) in 'a' .. 'z'
- or else
+ or else
Text (P) in 'A' .. 'Z')
and then Text (P + 1) = C
then
- if Warning_Doc_Switch then
- Warning_Msg_Char := Text (P);
- end if;
-
+ Warning_Msg_Char := Text (P);
P := P + 2;
+ else
+ Warning_Msg_Char := ' ';
end if;
end Set_Msg_Insertion_Warning;
begin
if Warn and then Warn_Chr /= ' ' then
if Warn_Chr = '?' then
- return " [enabled by default]";
+ return "[enabled by default]";
elsif Warn_Chr in 'a' .. 'z' then
- return " [-gnatw" & Warn_Chr & ']';
+ return "[-gnatw" & Warn_Chr & ']';
else pragma Assert (Warn_Chr in 'A' .. 'Z');
- return " [-gnatw." & Fold_Lower (Warn_Chr) & ']';
+ return "[-gnatw." & Fold_Lower (Warn_Chr) & ']';
end if;
else
return "";
Start : Natural;
begin
- -- Set error message line length
-
- if Error_Msg_Line_Length = 0 then
- Length := Nat'Last;
- else
- Length := Error_Msg_Line_Length;
- end if;
-
- Max := Integer (Length - Column + 1);
-
declare
- Txt : constant String := Text.all & Get_Warning_Tag (E);
- Len : constant Natural := Txt'Length;
+ Tag : constant String := Get_Warning_Tag (E);
+ Txt : String_Ptr;
+ Len : Natural;
begin
- -- For warning, add "warning: " unless msg starts with "info: "
+ -- Postfix warning tag to message if needed
+
+ if Tag /= "" and then Warning_Doc_Switch then
+ Txt := new String'(Text.all & ' ' & Tag);
+ else
+ Txt := Text;
+ end if;
+
+ -- Deal with warning case
if Errors.Table (E).Warn then
- if Len < 6
- or else Txt (Txt'First .. Txt'First + 5) /= "info: "
+
+ -- Nothing to do with info messages, "info " already set
+
+ if Txt'Length >= 6
+ and then Txt (Txt'First .. Txt'First + 5) = "info: "
then
- -- One more check, if warning is to be treated as error, then
- -- here is where we deal with that.
+ null;
- if Errors.Table (E).Warn_Err then
- Write_Str ("warning(error): ");
- Warnings_Treated_As_Errors := Warnings_Treated_As_Errors + 1;
- Max := Max - 16;
+ -- Warning treated as error
- -- Normal case
+ elsif Errors.Table (E).Warn_Err then
- else
- Write_Str ("warning: ");
- Max := Max - 9;
- end if;
+ -- We prefix the tag error: rather than warning: and postfix
+ -- [warning-as-error] at the end.
+
+ Warnings_Treated_As_Errors := Warnings_Treated_As_Errors + 1;
+ Txt := new String'("error: " & Txt.all & " [warning-as-error]");
+
+ -- Normal case, prefix
+
+ else
+ Txt := new String'("warning: " & Txt.all);
end if;
-- No prefix needed for style message, "(style)" is there already
elsif Errors.Table (E).Style then
null;
- -- All other cases, add "error: "
+ -- All other cases, add "error: " if unique error tag set
elsif Opt.Unique_Error_Tag then
- Write_Str ("error: ");
- Max := Max - 7;
+ Txt := new String'("error: " & Txt.all);
end if;
+ -- Set error message line length and length of message
+
+ if Error_Msg_Line_Length = 0 then
+ Length := Nat'Last;
+ else
+ Length := Error_Msg_Line_Length;
+ end if;
+
+ Max := Integer (Length - Column + 1);
+ Len := Txt'Length;
+
-- Here we have to split the message up into multiple lines
Ptr := 1;
-- as a result of a match with a Warning_As_Error pragma.
Warn_Chr : Character;
- -- Warning character, valid only if Warn is True
- -- ' ' -- ? appeared on its own in message
+ -- Warning character (note: set even if Warning_Doc_Switch is False)
+ -- ' ' -- ? appeared on its own in message or no ? in message
-- '?' -- ?? appeared in message
-- 'x' -- ?x? appeared in message
-- 'X' -- ?x? appeared in message (X is upper case of x)
(Return_Applies_To
(Return_Statement_Entity (Ancestor))))
then
- -- Pass along value that was passed in if the routine
- -- we are returning from also has an
- -- Accessibility_Of_Result formal.
+ -- Pass along value that was passed in if the returned
+ -- routine also has an Accessibility_Of_Result formal.
Level :=
New_Occurrence_Of
Subp := Parent_Subp;
end if;
- -- Check for violation of No_Abort_Statements
-
- if Restriction_Check_Required (No_Abort_Statements)
- and then Is_RTE (Subp, RE_Abort_Task)
- then
- Check_Restriction (No_Abort_Statements, Call_Node);
-
-- Check for violation of No_Dynamic_Attachment
- elsif Restriction_Check_Required (No_Dynamic_Attachment)
+ if Restriction_Check_Required (No_Dynamic_Attachment)
and then RTU_Loaded (Ada_Interrupts)
and then (Is_RTE (Subp, RE_Is_Reserved) or else
Is_RTE (Subp, RE_Is_Attached) or else
The pattern may contain asterisks, which match zero or more characters in
the message. For example, you can use
-@code{pragma Warnings (Off, "*bits of*unused")} to suppress the warning
-message @code{warning: 960 bits of "a" unused}. No other regular
+@code{pragma Warning_As_Error ("*bits of*unused")} to treat the warning
+message @code{warning: 960 bits of "a" unused} as an error. No other regular
expression notations are permitted. All characters other than asterisk in
these three specific cases are treated as literal characters in the match.
The match is case insensitive, for example XYZ matches xyz.
-Another possibility for the static_string_EXPRESSION which works if
-error tags are enabled (@option{-gnatw.e}) is to use the tag string
-preceded by a space,
-as shown in the example below.
+Another possibility for the static_string_EXPRESSION which works whether
+or not error tags are enabled (@option{-gnatw.d}) is to use the
+@option{-gnatw} tag string, enclosed in brackets,
+as shown in the example below, to treat a class of warnings as errors.
+
+The above use of patterns to match the message applies only to warning
+messages generated by the front end. This pragma can also be applied to
+warnings provided by the back end and mentioned in @ref{Pragma Warnings}.
+By using a single full @option{-Wxxx} switch in the pragma, such warnings
+can also be treated as errors.
The pragma can appear either in a global configuration pragma file
(e.g. @file{gnat.adc}), or at the start of a file. Given a global
configuration pragma file containing:
@smallexample @c ada
-pragma Warning_As_Error (" [-gnatwj]");
+pragma Warning_As_Error ("[-gnatwj]");
@end smallexample
@noindent
which will treat all obsolescent feature warnings as errors, the
following program compiles as shown (compile options here are
-@option{-gnatwa.e -gnatld7 -gnatj60}).
+@option{-gnatwa.d -gnatl -gnatj55}).
@smallexample @c ada
1. pragma Warning_As_Error ("*never assigned*");
2. function Warnerr return String is
3. X : Integer;
|
- >>> warning(error): variable "X" is never read and
- never assigned [-gnatwv]
+ >>> error: variable "X" is never read and
+ never assigned [-gnatwv] [warning-as-error]
4. Y : Integer;
|
- >>> warning: variable "Y" is assigned but never
- read [-gnatwu]
+ >>> warning: variable "Y" is assigned but
+ never read [-gnatwu]
- 5.
- 6. begin
- 7. Y := 0;
- 8. return %ABC%;
+ 5. begin
+ 6. Y := 0;
+ 7. return %ABC%;
|
- >>> warning(error): use of "%" is an obsolescent
- feature (RM J.2(4)), use """ instead [-gnatwj]
+ >>> error: use of "%" is an obsolescent
+ feature (RM J.2(4)), use """ instead
+ [-gnatwj] [warning-as-error]
- 9. end;
+ 8. end;
- 9 lines: No errors, 3 warnings (2 treated as errors)
+ 8 lines: No errors, 3 warnings (2 treated as errors)
@end smallexample
@noindent
Note that this pragma does not affect the set of warnings issued in
any way, it merely changes the effect of a matching warning if one
-is produced as a result of other warnings options.
+is produced as a result of other warnings options. As shown in this
+example, if the pragma results in a warning being treated as an error,
+the tag is changed from "warning:" to "error:" and the string
+"[warning-as-error]" is appended to the end of the message.
@node Pragma Warnings
@unnumberedsec Pragma Warnings
-- the spec of SPARK_Xrefs in file spark_xrefs.ads for full details of the
-- format.
+ -------------------------------
+ -- ALI File Generation for C --
+ -------------------------------
+
+ -- The C compiler can also generate ALI files for use by the IDE's in
+ -- providing navigation services in C. These ALI files are a subset of
+ -- the specification above, lacking all Ada-specific output. Primarily
+ -- the IDE uses the cross-reference sections of such files.
+
----------------------
-- Global Variables --
----------------------
| Attribute_Unchecked_Access
| Attribute_Unrestricted_Access =>
- Access_Attribute :
+ Access_Attribute : declare
+ Nam : Entity_Id;
+
begin
if Is_Variable (P) then
Note_Possible_Modification (P, Sure => False);
Get_Next_Interp (Index, It);
end loop;
- -- If Prefix is a subprogram name, it is frozen by this
- -- reference:
+ -- If Prefix is a subprogram name, this reference freezes:
-- If it is a type, there is nothing to resolve.
-- If it is an object, complete its resolution.
elsif Is_Overloadable (Entity (P)) then
+ Nam := Entity (P);
-- Avoid insertion of freeze actions in spec expression mode
Freeze_Before (N, Entity (P));
end if;
+ -- Forbid access to Abort_Task if restriction active
+
+ if Restriction_Check_Required (No_Abort_Statements)
+ and then
+ (Is_RTE (Nam, RE_Abort_Task)
+ or else
+ (Present (Alias (Nam))
+ and then Is_RTE (Alias (Nam), RE_Abort_Task)))
+ then
+ Check_Restriction (No_Abort_Statements, N);
+ end if;
+
elsif Is_Type (Entity (P)) then
null;
else
Nam := Entity (Subp);
Set_Entity_With_Style_Check (Subp, Nam);
+ -- Check restriction No_Abort_Statements, which is triggered by a
+ -- call to Ada.Task_Identification.Abort_Task.
+
+ if Restriction_Check_Required (No_Abort_Statements)
+ and then (Is_RTE (Nam, RE_Abort_Task)
+ or else (Present (Alias (Nam))
+ and then Is_RTE (Alias (Nam), RE_Abort_Task)))
+ then
+ Check_Restriction (No_Abort_Statements, N);
+ end if;
+
-- Otherwise we must have the case of an overloaded call
else
/* Register location blocks
------------------------
Rules to find registers of interest from the CFA. This should comprise
- all the non-volatile registers relevant to the interrupted context.
-
- ??? Note that r0 was excluded for consistency with the PPC version of
- this file, not sure if that's right. */
+ all the non-volatile registers relevant to the interrupted context. */
#define COMMON_CFI(REG) \
".cfi_offset " S(REGNO_##REG) "," S(REG_SET_##REG)
#define CFI_COMMON_REGS \
CR("# CFI for common registers\n") \
+TCR(COMMON_CFI(G_REG_OFFSET(0))) \
TCR(COMMON_CFI(G_REG_OFFSET(1))) \
TCR(COMMON_CFI(G_REG_OFFSET(2))) \
TCR(COMMON_CFI(G_REG_OFFSET(3))) \
Ineffective_Inline_Warnings := True;
List_Body_Required_Info := True;
List_Inherited_Aspects := True;
- Warning_Doc_Switch := True;
Warn_On_Ada_2005_Compatibility := True;
Warn_On_Ada_2012_Compatibility := True;
Warn_On_All_Unread_Out_Parameters := True;
projects / gcc.git / commitdiff