[multiple changes]

2017-01-20  Thomas Quinot  <quinot@adacore.com>

	* sem_warn.adb (Warn_On_Useless_Assignment): Adjust wording of warning
	message.

2017-01-20  Nicolas Roche  <roche@adacore.com>

	* terminals.c: Ignore failures on setpgid and tcsetpgrp commands.

2017-01-20  Bob Duff  <duff@adacore.com>

	* sem_eval.adb (Compile_Time_Compare): Disable the expr+literal
	(etc) optimizations when the type is modular.

2017-01-20  Yannick Moy  <moy@adacore.com>

	* sem_ch6.adb (Move_Pragmas): move some pragmas,
	but copy the SPARK_Mode pragma instead of moving it.
	(Build_Subprogram_Declaration): Ensure that the generated spec
	and original body share the same SPARK_Pragma aspect/pragma.
	* sem_util.adb, sem_util.ads (Copy_SPARK_Mode_Aspect): New
	procedure to copy SPARK_Mode aspect.

2017-01-20  Bob Duff  <duff@adacore.com>

	* sem_ch3.adb (Analyze_Declarations): Disable Resolve_Aspects
	even in ASIS mode.
	* sem_ch13.adb (Resolve_Name): Enable setting the entity to
	Empty even in ASIS mode.

From-SVN: r244720

9 files changed, 118 insertions, 47 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c6c5f92..404b638 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,33 @@
+2017-01-20  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_warn.adb (Warn_On_Useless_Assignment): Adjust wording of warning
+	message.
+
+2017-01-20  Nicolas Roche  <roche@adacore.com>
+
+	* terminals.c: Ignore failures on setpgid and tcsetpgrp commands.
+
+2017-01-20  Bob Duff  <duff@adacore.com>
+
+	* sem_eval.adb (Compile_Time_Compare): Disable the expr+literal
+	(etc) optimizations when the type is modular.
+
+2017-01-20  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch6.adb (Move_Pragmas): move some pragmas,
+	but copy the SPARK_Mode pragma instead of moving it.
+	(Build_Subprogram_Declaration): Ensure that the generated spec
+	and original body share the same SPARK_Pragma aspect/pragma.
+	* sem_util.adb, sem_util.ads (Copy_SPARK_Mode_Aspect): New
+	procedure to copy SPARK_Mode aspect.
+
+2017-01-20  Bob Duff  <duff@adacore.com>
+
+	* sem_ch3.adb (Analyze_Declarations): Disable Resolve_Aspects
+	even in ASIS mode.
+	* sem_ch13.adb (Resolve_Name): Enable setting the entity to
+	Empty even in ASIS mode.
+
 2017-01-20  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* exp_ch9.adb: minor style fixes in comments.
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 5e8822a..bdb53b1 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -12731,7 +12731,7 @@ package body Sem_Ch13 is
          elsif Nkind (N) = N_Identifier and then Chars (N) /= Chars (E) then
             Find_Direct_Name (N);
 
-            if not ASIS_Mode then
+            if True or else not ASIS_Mode then -- ????
                Set_Entity (N, Empty);
             end if;
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 7ee02bc..096170b 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2570,7 +2570,7 @@ package body Sem_Ch3 is
                --  rejected. Pending notification we restrict this call to
                --  ASIS mode.
 
-               if ASIS_Mode then
+               if False and then ASIS_Mode then -- ????
                   Resolve_Aspects;
                end if;
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 05631b3..5152ac1 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2399,8 +2399,10 @@ package body Sem_Ch6 is
          --  of subprogram body From and insert them after node To. The pragmas
          --  in question are:
          --    Ghost
-         --    SPARK_Mode
          --    Volatile_Function
+         --  Also copy pragma SPARK_Mode if present in the declarative list
+         --  of subprogram body From and insert it after node To. This pragma
+         --  should not be moved, as it applies to the body too.
 
          ------------------
          -- Move_Pragmas --
@@ -2425,14 +2427,17 @@ package body Sem_Ch6 is
             while Present (Decl) loop
                Next_Decl := Next (Decl);
 
-               if Nkind (Decl) = N_Pragma
-                 and then Nam_In (Pragma_Name_Unmapped (Decl),
-                                  Name_Ghost,
-                                  Name_SPARK_Mode,
-                                  Name_Volatile_Function)
-               then
-                  Remove (Decl);
-                  Insert_After (To, Decl);
+               if Nkind (Decl) = N_Pragma then
+                  if Pragma_Name_Unmapped (Decl) = Name_SPARK_Mode then
+                     Insert_After (To, New_Copy_Tree (Decl));
+
+                  elsif Nam_In (Pragma_Name_Unmapped (Decl),
+                                Name_Ghost,
+                                Name_Volatile_Function)
+                  then
+                     Remove (Decl);
+                     Insert_After (To, Decl);
+                  end if;
                end if;
 
                Decl := Next_Decl;
@@ -2463,6 +2468,13 @@ package body Sem_Ch6 is
          Move_Aspects (N, To => Subp_Decl);
          Move_Pragmas (N, To => Subp_Decl);
 
+         --  Ensure that the generated corresponding spec and original body
+         --  share the same SPARK_Mode pragma or aspect. As a result, both have
+         --  the same SPARK_Mode attributes, and the global SPARK_Mode value is
+         --  correctly set for local subprograms.
+
+         Copy_SPARK_Mode_Aspect (Subp_Decl, To => N);
+
          Analyze (Subp_Decl);
 
          --  Propagate the attributes Rewritten_For_C and Corresponding_Proc to
@@ -2515,13 +2527,6 @@ package body Sem_Ch6 is
          Body_Spec := Copy_Subprogram_Spec (Body_Spec);
          Set_Specification (N, Body_Spec);
          Body_Id := Analyze_Subprogram_Specification (Body_Spec);
-
-         --  Ensure that the generated corresponding spec and original body
-         --  share the same SPARK_Mode attributes.
-
-         Set_SPARK_Pragma (Body_Id, SPARK_Pragma (Spec_Id));
-         Set_SPARK_Pragma_Inherited
-           (Body_Id, SPARK_Pragma_Inherited (Spec_Id));
       end Build_Subprogram_Declaration;
 
       ----------------------------
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 936c1c3..b421926 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -1142,7 +1142,7 @@ package body Sem_Eval is
          return Unknown;
       end if;
 
-      --  We do not attempt comparisons for packed arrays arrays represented as
+      --  We do not attempt comparisons for packed arrays represented as
       --  modular types, where the semantics of comparison is quite different.
 
       if Is_Packed_Array_Impl_Type (Ltyp)
@@ -1329,28 +1329,35 @@ package body Sem_Eval is
          --  J .. J + 1. This code can conclude LT with a difference of 1,
          --  even if the range of J is not known.
 
-         declare
-            Lnode : Node_Id;
-            Loffs : Uint;
-            Rnode : Node_Id;
-            Roffs : Uint;
+         --  This would be wrong for modular types (e.g. X < X + 1 is False if
+         --  X is the largest number).
 
-         begin
-            Compare_Decompose (L, Lnode, Loffs);
-            Compare_Decompose (R, Rnode, Roffs);
+         if not Is_Modular_Integer_Type (Ltyp)
+           and then not Is_Modular_Integer_Type (Rtyp)
+         then
+            declare
+               Lnode : Node_Id;
+               Loffs : Uint;
+               Rnode : Node_Id;
+               Roffs : Uint;
 
-            if Is_Same_Value (Lnode, Rnode) then
-               if Loffs = Roffs then
-                  return EQ;
-               elsif Loffs < Roffs then
-                  Diff.all := Roffs - Loffs;
-                  return LT;
-               else
-                  Diff.all := Loffs - Roffs;
-                  return GT;
+            begin
+               Compare_Decompose (L, Lnode, Loffs);
+               Compare_Decompose (R, Rnode, Roffs);
+
+               if Is_Same_Value (Lnode, Rnode) then
+                  if Loffs = Roffs then
+                     return EQ;
+                  elsif Loffs < Roffs then
+                     Diff.all := Roffs - Loffs;
+                     return LT;
+                  else
+                     Diff.all := Loffs - Roffs;
+                     return GT;
+                  end if;
                end if;
-            end if;
-         end;
+            end;
+         end if;
 
          --  Next, try range analysis and see if operand ranges are disjoint
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 0e1a0c0..73c8ce0 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -4999,6 +4999,24 @@ package body Sem_Util is
       return Plist;
    end Copy_Parameter_List;
 
+   ----------------------------
+   -- Copy_SPARK_Mode_Aspect --
+   ----------------------------
+
+   procedure Copy_SPARK_Mode_Aspect (From : Node_Id; To : Node_Id) is
+      pragma Assert (not Has_Aspects (To));
+      Asp : Node_Id;
+   begin
+      if Has_Aspects (From) then
+         Asp := Find_Aspect (Defining_Entity (From), Aspect_SPARK_Mode);
+
+         if Present (Asp) then
+            Set_Aspect_Specifications (To, New_List (New_Copy_Tree (Asp)));
+            Set_Has_Aspects (To, True);
+         end if;
+      end if;
+   end Copy_SPARK_Mode_Aspect;
+
    --------------------------
    -- Copy_Subprogram_Spec --
    --------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index b437412..d084800 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -424,6 +424,12 @@ package Sem_Util is
    --  of inlining, and for private protected ops. Also used to create bodies
    --  for stubbed subprograms.
 
+   procedure Copy_SPARK_Mode_Aspect (From : Node_Id; To : Node_Id);
+   --  Copy the SPARK_Mode aspect if present in the aspect specifications
+   --  of node From to node To. On entry it is assumed that To does not have
+   --  aspect specifications. If From has no aspects, the routine has no
+   --  effect.
+
    function Copy_Subprogram_Spec (Spec : Node_Id) return Node_Id;
    --  Replicate a function or a procedure specification denoted by Spec. The
    --  resulting tree is an exact duplicate of the original tree. New entities
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 5cd37f0..ad278e8 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -4323,7 +4323,12 @@ package body Sem_Warn is
                   begin
                      --  Don't give this for OUT and IN OUT formals, since
                      --  clearly caller may reference the assigned value. Also
-                     --  never give such warnings for internal variables.
+                     --  never give such warnings for internal variables. In
+                     --  either case, word the warning in a conditional way,
+                     --  because in the case of a component of a controlled
+                     --  type, the assigned value might be referenced in the
+                     --  Finalize operation, so we can't make a definitive
+                     --  statement that it's never referenced.
 
                      if Ekind (Ent) = E_Variable
                        and then not Is_Internal_Name (Chars (Ent))
@@ -4335,13 +4340,13 @@ package body Sem_Warn is
                                                   N_Parameter_Association)
                         then
                            Error_Msg_NE
-                             ("?m?& modified by call, but value never "
-                              & "referenced", LA, Ent);
+                             ("?m?& modified by call, but value might not "
+                              & "be referenced", LA, Ent);
 
                         else
                            Error_Msg_NE -- CODEFIX
-                             ("?m?useless assignment to&, value never "
-                              & "referenced!", LA, Ent);
+                             ("?m?possibly useless assignment to&, value "
+                              & "might not be referenced!", LA, Ent);
                         end if;
                      end if;
                   end;
diff --git a/gcc/ada/terminals.c b/gcc/ada/terminals.c
index 35185c7..35cd743 100644
--- a/gcc/ada/terminals.c
+++ b/gcc/ada/terminals.c
@@ -1425,10 +1425,10 @@ __gnat_setup_child_communication
   if (desc->slave_fd > 2) close (desc->slave_fd);
 
   /* adjust process group settings */
-  if ((status = setpgid (pid, pid)) == -1)
-    return -1;
-  if ((status = tcsetpgrp (0, pid)) == -1)
-    return -1;
+  /* ignore failures of the following two commands as the context might not
+   * allow making those changes. */
+  setpgid (pid, pid);
+  tcsetpgrp (0, pid);
 
   /* launch the program */
   execvp (new_argv[0], new_argv);