[multiple changes]

2010-10-04  Bob Duff  <duff@adacore.com>

	* sem_res.adb (Resolve_Type_Conversion): If a type conversion is needed
	to make a qualified expression into a name (syntax-wise), then do not
	consider it redundant.

2010-10-04  Thomas Quinot  <quinot@adacore.com>

	* sem_warn.ads: Fix typo.

2010-10-04  Javier Miranda  <miranda@adacore.com>

	* exp_cg.adb (Is_Predefined_Dispatching_Operation): Handle suffix in
	TSS names.
	(Write_Call_Info): Add missing support for renamed primitives.

2010-10-04  Thomas Quinot  <quinot@adacore.com>

	* exp_ch5.adb (Make_Field_Expr): New subprogram, to factor duplicated
	code between Make_Component_List_Assign and Make_Field_Assign.

2010-10-04  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Get_Directories): For non extending projects that
	declare that they have no sources, do not create a non existing object
	or exec directory if builder switch -p is used.

2010-10-04  Sergey Rybin  <rybin@adacore.com>

	* gnat_ugn.texi (gnatcheck): Change the description of the report file
	format.

2010-10-04  Ed Falis  <falis@adacore.com>

	* s-taprop-vxworks.adb (Is_Task_Context): Import VxWorks intContext to
	determine whether Set_True is called from a task or an ISR.
	(Set_True): test for being in a task context before trying to
	dereference Defer_Abort or Undefer_Abort.

From-SVN: r164936

8 files changed, 198 insertions, 105 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 226f740..c06dd65 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,42 @@
+2010-10-04  Bob Duff  <duff@adacore.com>
+
+	* sem_res.adb (Resolve_Type_Conversion): If a type conversion is needed
+	to make a qualified expression into a name (syntax-wise), then do not
+	consider it redundant.
+
+2010-10-04  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_warn.ads: Fix typo.
+
+2010-10-04  Javier Miranda  <miranda@adacore.com>
+
+	* exp_cg.adb (Is_Predefined_Dispatching_Operation): Handle suffix in
+	TSS names.
+	(Write_Call_Info): Add missing support for renamed primitives.
+
+2010-10-04  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch5.adb (Make_Field_Expr): New subprogram, to factor duplicated
+	code between Make_Component_List_Assign and Make_Field_Assign.
+
+2010-10-04  Vincent Celier  <celier@adacore.com>
+
+	* prj-nmsc.adb (Get_Directories): For non extending projects that
+	declare that they have no sources, do not create a non existing object
+	or exec directory if builder switch -p is used.
+
+2010-10-04  Sergey Rybin  <rybin@adacore.com>
+
+	* gnat_ugn.texi (gnatcheck): Change the description of the report file
+	format.
+
+2010-10-04  Ed Falis  <falis@adacore.com>
+
+	* s-taprop-vxworks.adb (Is_Task_Context): Import VxWorks intContext to
+	determine whether Set_True is called from a task or an ISR.
+	(Set_True): test for being in a task context before trying to
+	dereference Defer_Abort or Undefer_Abort.
+
 2010-10-04  Robert Dewar  <dewar@adacore.com>
 
 	* sem_res.adb, sinput-l.adb: Minor reformatting.
diff --git a/gcc/ada/exp_cg.adb b/gcc/ada/exp_cg.adb
index 84b1ee9..004cf44 100644
--- a/gcc/ada/exp_cg.adb
+++ b/gcc/ada/exp_cg.adb
@@ -213,8 +213,9 @@ package body Exp_CG is
 
       --  Local variables
 
-      Full_Name : constant String := Get_Name_String (Chars (E));
-      TSS_Name  : TSS_Name_Type;
+      Full_Name     : constant String := Get_Name_String (Chars (E));
+      Suffix_Length : Natural         := Homonym_Suffix_Length (E);
+      TSS_Name      : TSS_Name_Type;
 
    --  Start of processing for Is_Predefined_Dispatching_Operation
 
@@ -223,14 +224,31 @@ package body Exp_CG is
          return False;
       end if;
 
+      --  Search for and strip suffix for body-nested package entities
+
+      for J in reverse Full_Name'First + 2 .. Full_Name'Last loop
+         if Full_Name (J) = 'X' then
+
+            --  Include the "X", "Xb", "Xn", ... in the part of the
+            --  suffix to be removed.
+
+            Suffix_Length := Suffix_Length + Full_Name'Last - J + 1;
+            exit;
+         end if;
+
+         exit when Full_Name (J) /= 'b' and then Full_Name (J) /= 'n';
+      end loop;
+
       --  Most predefined primitives have internally generated names. Equality
       --  must be treated differently; the predefined operation is recognized
       --  as a homogeneous binary operator that returns Boolean.
 
       if Full_Name'Length > TSS_Name_Type'Length then
          TSS_Name :=
-           TSS_Name_Type (Full_Name (Full_Name'Last - TSS_Name'Length + 1
-                           .. Full_Name'Last));
+           TSS_Name_Type
+             (Full_Name
+               (Full_Name'Last - TSS_Name'Length - Suffix_Length + 1
+                  .. Full_Name'Last - Suffix_Length));
 
          if        TSS_Name = TSS_Stream_Read
            or else TSS_Name = TSS_Stream_Write
@@ -273,25 +291,7 @@ package body Exp_CG is
                                     Name_uDisp_Requeue,
                                     Name_uDisp_Timed_Select);
 
-               Suffix_Length : Natural;
-
             begin
-               --  Search for and strip suffix for body-nested package entities
-
-               Suffix_Length := Homonym_Suffix_Length (E);
-               for J in reverse Full_Name'First + 2 .. Full_Name'Last loop
-                  if Full_Name (J) = 'X' then
-
-                     --  Include the "X", "Xb", "Xn", ... in the part of the
-                     --  suffix to be removed.
-
-                     Suffix_Length := Suffix_Length + Full_Name'Last - J + 1;
-                     exit;
-                  end if;
-
-                  exit when Full_Name (J) /= 'b' and then Full_Name (J) /= 'n';
-               end loop;
-
                for J in Predef_Names_95'Range loop
                   Get_Name_String (Predef_Names_95 (J));
 
@@ -476,7 +476,12 @@ package body Exp_CG is
             (Find_Dispatching_Type (Ultimate_Alias (Prim)),
              Root_Type (Ctrl_Typ))
       then
-         Write_Int (UI_To_Int (Slot_Number (Ultimate_Alias (Prim))));
+         --  This is a special case in which we generate in the ci file the
+         --  slot number of the renaming primitive (i.e. Base2) but instead of
+         --  generating the name of this renaming entity we reference directly
+         --  the renamed entity (i.e. Base).
+
+         Write_Int (UI_To_Int (Slot_Number (Prim)));
          Write_Char (':');
          Write_Name
            (Chars (Find_Dispatching_Type (Ultimate_Alias (Prim))));
@@ -569,9 +574,10 @@ package body Exp_CG is
       while Present (Elmt) loop
          Prim := Node (Elmt);
 
-         --  Display only primitives overriden or defined
+         --  Skip internal entities associated with overridden interface
+         --  primitives
 
-         if Present (Alias (Prim)) then
+         if Present (Interface_Alias (Prim)) then
             goto Continue;
          end if;
 
@@ -587,7 +593,14 @@ package body Exp_CG is
 
          Write_Int (UI_To_Int (Slot_Number (Prim)));
          Write_Char (':');
-         Write_Name (Chars (Prim));
+
+         --  Handle renamed primitives
+
+         if Present (Alias (Prim)) then
+            Write_Name (Chars (Ultimate_Alias (Prim)));
+         else
+            Write_Name (Chars (Prim));
+         end if;
 
          --  Display overriding of parent primitives
 
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 6c7c8ce..7eaa30e 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -1041,7 +1041,7 @@ package body Exp_Ch5 is
       --  Note that on the last iteration of the loop, the index is increased
       --  (or decreased) past the corresponding bound. This is consistent with
       --  the C semantics of the back-end, where such an off-by-one value on a
-      --  dead index variable is OK.  However, in CodePeer mode this leads to
+      --  dead index variable is OK. However, in CodePeer mode this leads to
       --  spurious warnings, and thus we place a guard around the attribute
       --  reference. For obvious reasons we only do this for CodePeer.
 
@@ -1223,6 +1223,13 @@ package body Exp_Ch5 is
          --  declaration for Typ. We need to use the actual entity because the
          --  type may be private and resolution by identifier alone would fail.
 
+         function Make_Field_Expr
+           (Comp_Ent : Entity_Id;
+            U_U      : Boolean) return Node_Id;
+         --  Common processing for one component for Make_Component_List_Assign
+         --  and Make_Field_Assign. Return the expression to be assigned for
+         --  component Comp_Ent.
+
          function Make_Component_List_Assign
            (CL  : Node_Id;
             U_U : Boolean := False) return List_Id;
@@ -1232,7 +1239,7 @@ package body Exp_Ch5 is
          --  part expression as the switch for the generated case statement.
 
          function Make_Field_Assign
-           (C : Entity_Id;
+           (C   : Entity_Id;
             U_U : Boolean := False) return Node_Id;
          --  Given C, the entity for a discriminant or component, build an
          --  assignment for the corresponding field values. The flag U_U
@@ -1282,7 +1289,6 @@ package body Exp_Ch5 is
             Alts   : List_Id;
             DC     : Node_Id;
             DCH    : List_Id;
-            Expr   : Node_Id;
             Result : List_Id;
             V      : Node_Id;
 
@@ -1308,28 +1314,9 @@ package body Exp_Ch5 is
                   Next_Non_Pragma (V);
                end loop;
 
-               --  If we have an Unchecked_Union, use the value of the inferred
-               --  discriminant of the variant part expression as the switch
-               --  for the case statement. The case statement may later be
-               --  folded.
-
-               if U_U then
-                  Expr :=
-                    New_Copy (Get_Discriminant_Value (
-                      Entity (Name (VP)),
-                      Etype (Rhs),
-                      Discriminant_Constraint (Etype (Rhs))));
-               else
-                  Expr :=
-                    Make_Selected_Component (Loc,
-                      Prefix => Duplicate_Subexpr (Rhs),
-                      Selector_Name =>
-                        Make_Identifier (Loc, Chars (Name (VP))));
-               end if;
-
                Append_To (Result,
                  Make_Case_Statement (Loc,
-                   Expression => Expr,
+                   Expression   => Make_Field_Expr (Entity (Name (VP)), U_U),
                    Alternatives => Alts));
             end if;
 
@@ -1341,36 +1328,23 @@ package body Exp_Ch5 is
          -----------------------
 
          function Make_Field_Assign
-           (C : Entity_Id;
+           (C   : Entity_Id;
             U_U : Boolean := False) return Node_Id
          is
             A    : Node_Id;
-            Expr : Node_Id;
 
          begin
             --  In the case of an Unchecked_Union, use the discriminant
             --  constraint value as on the right hand side of the assignment.
 
-            if U_U then
-               Expr :=
-                 New_Copy (Get_Discriminant_Value (C,
-                   Etype (Rhs),
-                   Discriminant_Constraint (Etype (Rhs))));
-            else
-               Expr :=
-                 Make_Selected_Component (Loc,
-                   Prefix => Duplicate_Subexpr (Rhs),
-                   Selector_Name => New_Occurrence_Of (C, Loc));
-            end if;
-
             A :=
               Make_Assignment_Statement (Loc,
-                Name =>
+                Name       =>
                   Make_Selected_Component (Loc,
-                    Prefix => Duplicate_Subexpr (Lhs),
+                    Prefix        => Duplicate_Subexpr (Lhs),
                     Selector_Name =>
                       New_Occurrence_Of (Find_Component (L_Typ, C), Loc)),
-                Expression => Expr);
+                Expression => Make_Field_Expr (C, U_U));
 
             --  Set Assignment_OK, so discriminants can be assigned
 
@@ -1395,8 +1369,9 @@ package body Exp_Ch5 is
             Result : List_Id;
 
          begin
-            Item := First (CI);
             Result := New_List;
+
+            Item := First (CI);
             while Present (Item) loop
 
                --  Look for components, but exclude _tag field assignment if
@@ -1404,7 +1379,7 @@ package body Exp_Ch5 is
 
                if Nkind (Item) = N_Component_Declaration
                  and then not (Is_Tag (Defining_Identifier (Item))
-                                and then Componentwise_Assignment (N))
+                                 and then Componentwise_Assignment (N))
                then
                   Append_To
                     (Result, Make_Field_Assign (Defining_Identifier (Item)));
@@ -1416,6 +1391,32 @@ package body Exp_Ch5 is
             return Result;
          end Make_Field_Assigns;
 
+         ---------------------
+         -- Make_Field_Expr --
+         ---------------------
+
+         function Make_Field_Expr
+           (Comp_Ent : Entity_Id;
+            U_U      : Boolean) return Node_Id
+         is
+         begin
+            --  If we have an Unchecked_Union, use the value of the inferred
+            --  discriminant of the variant part expression.
+
+            if U_U then
+               return
+                 New_Copy (Get_Discriminant_Value
+                   (Comp_Ent,
+                    Etype (Rhs),
+                    Discriminant_Constraint (Etype (Rhs))));
+            else
+               return
+                 Make_Selected_Component (Loc,
+                   Prefix        => Duplicate_Subexpr (Rhs),
+                   Selector_Name => New_Occurrence_Of (Comp_Ent, Loc));
+            end if;
+         end Make_Field_Expr;
+
       --  Start of processing for Expand_Assign_Record
 
       begin
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 8008602..eb7a9c5 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -17291,21 +17291,24 @@ supplied.
 @cindex Report file (for @code{gnatcheck})
 
 @noindent
-The @command{gnatcheck} tool outputs on @file{stdout} all messages concerning
-rule violations.
-It also creates a text file  that
-contains the complete report of the last gnatcheck run. By default this file
-is named named @file{^gnatcheck.out^GNATCHECK.OUT^} and it is located in the
+The @command{gnatcheck} tool outputs on @file{stderr} all messages concerning
+rule violations except if running in quiet mode.  It also creates a text file
+that contains the complete report of the last gnatcheck run. By default this file
+is named @file{^gnatcheck.out^GNATCHECK.OUT^} and it is located in the
 current directory; the @option{^-o^/OUTPUT^} option can be used to change the
 name and/or location of the report file. This report contains:
+
 @itemize @bullet
-@item date and time of @command{gnatcheck} run, the version of
-the tool that has generated this report and the full parameters
-of the  @command{gnatcheck} invocation;
-@item list of enabled rules;
-@item total number of detected violations;
-@item list of source files where rule violations have been detected;
-@item list of source files where no violations have been detected.
+
+@item general details of the @command{gnatcheck} run: date and time of the run,
+the version of the tool that has generated this report, full parameters
+of the  @command{gnatcheck} invocation, reference to the list of checked
+sources and applied rules (coding standard);
+@item summary of the run (number of checked sources and detected violations);
+@item list of exempted coding standard violations;
+@item list of non-exempted coding standard violations;
+@item list of problems in the definition of exemption sections;
+@item of language violations (compile-time errors) detected in processed sources;
 @end itemize
 
 @node General gnatcheck Switches
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index af9a622..babb17d 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -5280,10 +5280,18 @@ package body Prj.Nmsc is
          Recursive_Dirs.Reset (Visited);
       end Find_Source_Dirs;
 
-   --  Start of processing for Get_Directories
-
       Dir_Exists : Boolean;
 
+      No_Sources : constant Boolean :=
+        (((not Source_Files.Default) and then Source_Files.Values = Nil_String)
+         or else
+         ((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String)
+         or else
+         ((not Languages.Default) and then Languages.Values = Nil_String))
+        and then Project.Extends = No_Project;
+
+   --  Start of processing for Get_Directories
+
    begin
       if Current_Verbosity = High then
          Write_Line ("Starting to look for directories");
@@ -5292,14 +5300,7 @@ package body Prj.Nmsc is
       --  Set the object directory to its default which may be nil, if there
       --  is no sources in the project.
 
-      if (((not Source_Files.Default)
-             and then Source_Files.Values = Nil_String)
-          or else
-           ((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String)
-              or else
-           ((not Languages.Default) and then Languages.Values = Nil_String))
-        and then Project.Extends = No_Project
-      then
+      if No_Sources then
          Project.Object_Directory := No_Path_Information;
       else
          Project.Object_Directory := Project.Directory;
@@ -5316,7 +5317,7 @@ package body Prj.Nmsc is
                "Object_Dir cannot be empty",
                Object_Dir.Location, Project);
 
-         else
+         elsif not No_Sources then
             --  We check that the specified object directory does exist.
             --  However, even when it doesn't exist, we set it to a default
             --  value. This is for the benefit of tools that recover from
@@ -5348,9 +5349,7 @@ package body Prj.Nmsc is
             end if;
          end if;
 
-      elsif Project.Object_Directory /= No_Path_Information
-        and then Subdirs /= null
-      then
+      elsif not No_Sources and then Subdirs /= null then
          Name_Len := 1;
          Name_Buffer (1) := '.';
          Locate_Directory
@@ -5389,7 +5388,7 @@ package body Prj.Nmsc is
                "Exec_Dir cannot be empty",
                Exec_Dir.Location, Project);
 
-         else
+         elsif not No_Sources then
             --  We check that the specified exec directory does exist
 
             Locate_Directory
diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb
index 2cf8131..7380edd 100644
--- a/gcc/ada/s-taprop-vxworks.adb
+++ b/gcc/ada/s-taprop-vxworks.adb
@@ -163,6 +163,10 @@ package body System.Task_Primitives.Operations is
    procedure Install_Signal_Handlers;
    --  Install the default signal handlers for the current task
 
+   function Is_Task_Context return Boolean;
+   --  This function returns True if the current execution is in the context
+   --  of a task, and False if it is an interrupt context.
+
    function To_Address is
      new Ada.Unchecked_Conversion (Task_Id, System.Address);
 
@@ -1095,7 +1099,12 @@ package body System.Task_Primitives.Operations is
       Result : STATUS;
 
    begin
-      SSL.Abort_Defer.all;
+
+      --  Set_True can be called from an interrupt context, in which case
+      --  Abort_Defer is undefined.
+      if Is_Task_Context then
+         SSL.Abort_Defer.all;
+      end if;
 
       Result := semTake (S.L, WAIT_FOREVER);
       pragma Assert (Result = OK);
@@ -1118,7 +1127,12 @@ package body System.Task_Primitives.Operations is
       Result := semGive (S.L);
       pragma Assert (Result = OK);
 
-      SSL.Abort_Undefer.all;
+      --  Set_True can be called from an interrupt context, in which case
+      --  Abort_Undefer is undefined.
+      if Is_Task_Context then
+         SSL.Abort_Undefer.all;
+      end if;
+
    end Set_True;
 
    ------------------------
@@ -1316,6 +1330,19 @@ package body System.Task_Primitives.Operations is
       end if;
    end Continue_Task;
 
+   ---------------------
+   -- Is_Task_Context --
+   ---------------------
+
+   function Is_Task_Context return Boolean is
+      function intContext return int;
+      --  Binding to the C routine intContext. This function returns 1 only
+      --  if the current execution state is an interrupt context.
+      pragma Import (C, intContext, "intContext");
+   begin
+      return intContext /= 1;
+   end Is_Task_Context;
+
    ----------------
    -- Initialize --
    ----------------
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index c019c30..23107cb 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -8843,15 +8843,26 @@ package body Sem_Res is
             then
                null;
 
-            --  Finally, the expression may be a qualified expression whose
-            --  own expression is a possibly overloaded function call. The
-            --  qualified expression is needed to be disambiguate the call,
-            --  but it appears in a context in which a name is needed, forcing
-            --  the use of a conversion. In Ada 2012, a qualified expression is
-            --  a name, and this idiom is no longer needed.
+            --  Finally, if this type conversion occurs in a context that
+            --  requires a prefix, and the expression is a qualified
+            --  expression, then the type conversion is not redundant,
+            --  because a qualified expression is not a prefix, whereas a
+            --  type conversion is. For example, "X := T'(Funx(...)).Y;" is
+            --  illegal. because a selected component requires a prefix, but
+            --  a type conversion makes it legal: "X := T(T'(Funx(...))).Y;"
+            --  In Ada 2012, a qualified expression is a name, so this idiom is
+            --  no longer needed, but we still suppress the warning because it
+            --  seems unfriendly for warnings to pop up when you switch to the
+            --  newer language version.
 
             elsif Nkind (Orig_N) = N_Qualified_Expression
-              and then Nkind (Expression (Orig_N)) = N_Function_Call
+              and then Nkind_In
+                         (Parent (N),
+                          N_Attribute_Reference,
+                          N_Indexed_Component,
+                          N_Selected_Component,
+                          N_Slice,
+                          N_Explicit_Dereference)
             then
                null;
 
diff --git a/gcc/ada/sem_warn.ads b/gcc/ada/sem_warn.ads
index c7e3fd2..6356293 100644
--- a/gcc/ada/sem_warn.ads
+++ b/gcc/ada/sem_warn.ads
@@ -50,7 +50,7 @@ package Sem_Warn is
    Warn_On_Overridden_Size : Boolean := False;
    --  Warn when explicit record component clause or array component_size
    --  clause specifies a size that overrides a size for the typen which was
-   --  set with an explicit size clause. Off by default, set by -gnatw.sn (but
+   --  set with an explicit size clause. Off by default, set by -gnatw.s (but
    --  not -gnatwa).
 
    ------------------------