2014-02-25 Eric Botcazou <ebotcazou@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 25 Feb 2014 15:49:45 +0000 (15:49 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 25 Feb 2014 15:49:45 +0000 (15:49 +0000)
* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@208146 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/errout.adb
gcc/ada/erroutc.adb
gcc/ada/erroutc.ads
gcc/ada/exp_ch6.adb
gcc/ada/gnat_rm.texi
gcc/ada/lib-writ.ads
gcc/ada/sem_attr.adb
gcc/ada/sem_res.adb
gcc/ada/sigtramp-armvxw.c
gcc/ada/warnsw.adb

index 8dc578e..7aef153 100644 (file)
@@ -1,3 +1,30 @@
+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
index 76b8cbc..b625589 100644 (file)
@@ -732,6 +732,7 @@ package body Errout is
       Continuation_New_Line := False;
       Suppress_Message := False;
       Kill_Message := False;
+      Warning_Msg_Char := ' ';
       Set_Msg_Text (Msg, Sptr);
 
       --  Kill continuation if parent message killed
@@ -2756,26 +2757,20 @@ package body Errout is
 
       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;
 
index 5c72532..3f16702 100644 (file)
@@ -309,11 +309,11 @@ package body Erroutc is
    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 "";
@@ -554,41 +554,45 @@ package body Erroutc is
       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
@@ -596,13 +600,23 @@ package body Erroutc is
          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;
index fa4db90..5861128 100644 (file)
@@ -200,8 +200,8 @@ package Erroutc is
       --  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)
index 74c864a..58e945e 100644 (file)
@@ -3253,9 +3253,8 @@ package body Exp_Ch6 is
                                (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
@@ -3642,16 +3641,9 @@ package body Exp_Ch6 is
          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
index 99711e4..138551d 100644 (file)
@@ -7578,60 +7578,69 @@ which treats all warnings as errors.
 
 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
index cfcc01c..c68f3c6 100644 (file)
@@ -848,6 +848,15 @@ package Lib.Writ is
    --  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 --
    ----------------------
index 4924878..6a0c892 100644 (file)
@@ -9645,7 +9645,9 @@ package body Sem_Attr is
             | 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);
@@ -9684,13 +9686,13 @@ package body Sem_Attr is
                      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
 
@@ -9698,6 +9700,18 @@ package body Sem_Attr is
                      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
index 96d2242..cbb4de9 100644 (file)
@@ -5408,6 +5408,17 @@ package body Sem_Res is
          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
index fbd58b7..176be21 100644 (file)
@@ -165,16 +165,14 @@ CR(".cfi_def_cfa " S(CFA_REG) ", 0")
 /* 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)))  \
index 5cb12ad..f07fdf9 100644 (file)
@@ -267,7 +267,6 @@ package body Warnsw is
             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;