[multiple changes]

2012-10-01  Thomas Quinot  <quinot@adacore.com>

	* gnatcmd.adb, make.adb (Scan_Make_Arg, Inspect_Switches): Recognize
	and reject an invalid parameter passed to -vP.

2012-10-01  Yannick Moy  <moy@adacore.com>

	* sem_warn.adb (Check_Infinite_Loop_Warning/Test_Ref): Improve
	the detection of modifications to the loop variable by noting
	that, if the type of variable is elementary and the condition
	does not contain a function call, then the condition cannot be
	modified by side-effects from a procedure call.

2012-10-01  Robert Dewar  <dewar@adacore.com>

	* checks.adb: Add comments.

2012-10-01  Javier Miranda  <miranda@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration): Improve condition catching
	never-ending recursion. The previous condition erroneously disabled
	silently the expansion of the class-wide interface object
	initialization in cases not involving the recursion.

From-SVN: r191892

gcc/ada/ChangeLog

 2012-10-01  Thomas Quinot  <quinot@adacore.com>
 
+	* gnatcmd.adb, make.adb (Scan_Make_Arg, Inspect_Switches): Recognize
+	and reject an invalid parameter passed to -vP.
+
+2012-10-01  Yannick Moy  <moy@adacore.com>
+
+	* sem_warn.adb (Check_Infinite_Loop_Warning/Test_Ref): Improve
+	the detection of modifications to the loop variable by noting
+	that, if the type of variable is elementary and the condition
+	does not contain a function call, then the condition cannot be
+	modified by side-effects from a procedure call.
+
+2012-10-01  Robert Dewar  <dewar@adacore.com>
+
+	* checks.adb: Add comments.
+
+2012-10-01  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch3.adb (Expand_N_Object_Declaration): Improve condition catching
+	never-ending recursion. The previous condition erroneously disabled
+	silently the expansion of the class-wide interface object
+	initialization in cases not involving the recursion.
+
+2012-10-01  Thomas Quinot  <quinot@adacore.com>
+
 	* make.adb: Minor documentation fix: error messages are sent to
 	stderr, not stdout.
 

gcc/ada/checks.adb

@@ -1791,6 +1791,8 @@ package body Checks is
       --  Do not generate the checks in Ada 83, 95 or 05 mode because they
       --  require an Ada 2012 construct.
 
+      --  Why??? these pragmas and attributes are available in all ada modes
+
       if Ada_Version_Explicit < Ada_2012 then
          return;
       end if;
@@ -1932,9 +1934,11 @@ package body Checks is
       --  Extract the subprogram specification and declaration nodes
 
       Subp_Spec := Parent (Subp);
+
       if Nkind (Subp_Spec) = N_Defining_Program_Unit_Name then
          Subp_Spec := Parent (Subp_Spec);
       end if;
+
       Subp_Decl := Parent (Subp_Spec);
 
       --  Do not generate checks in Ada 83 or 95 because the pragmas involved
@@ -1961,6 +1965,9 @@ package body Checks is
       --  through the its contract and recover the pre and post conditions (if
       --  available).
 
+      --  So what??? you can have multiple such pragmas, this is unnecessary
+      --  complexity being added for no purpose???
+
       if Present (Contract (Subp)) then
          declare
             Nam  : Name_Id;
@@ -2080,6 +2087,9 @@ package body Checks is
       --  Do not process subprograms where pre and post conditions do not make
       --  sense.
 
+      --  More detail here of why these specific conditions are needed???
+      --  And remember to document them ???
+
       if not Comes_From_Source (Subp)
         or else Is_Imported (Subp)
         or else Is_Intrinsic_Subprogram (Subp)
@@ -2127,6 +2137,7 @@ package body Checks is
 
    procedure Apply_Predicate_Check (N : Node_Id; Typ : Entity_Id) is
       S : Entity_Id;
+
    begin
       if Present (Predicate_Function (Typ)) then
 
@@ -2134,17 +2145,12 @@ package body Checks is
          --  subprograms, such as TSS functions.
 
          S := Current_Scope;
-         while Present (S)
-           and then not Is_Subprogram (S)
-         loop
+         while Present (S) and then not Is_Subprogram (S) loop
             S := Scope (S);
          end loop;
 
-         if Present (S)
-           and then Get_TSS_Name (S) /= TSS_Null
-         then
+         if Present (S) and then Get_TSS_Name (S) /= TSS_Null then
             return;
-
          else
             Insert_Action (N,
               Make_Predicate_Check (Typ, Duplicate_Subexpr (N)));

gcc/ada/exp_ch3.adb

@@ -4910,8 +4910,15 @@ package body Exp_Ch3 is
          --  Expr's type, both types share the same dispatch table and there is
          --  no need to displace the pointer.
 
-         elsif Comes_From_Source (N)
-           and then Is_Interface (Typ)
+         elsif Is_Interface (Typ)
+
+           --  Avoid never-ending recursion because if Equivalent_Type is set
+           --  then we've done it already and must not do it again!
+
+           and then not
+             (Nkind (Object_Definition (N)) = N_Identifier
+                and then
+              Present (Equivalent_Type (Entity (Object_Definition (N)))))
          then
             pragma Assert (Is_Class_Wide_Type (Typ));
 

gcc/ada/gnatcmd.adb

@@ -1769,19 +1769,27 @@ begin
 
                   --  -vPx  Specify verbosity while parsing project files
 
-                  elsif Argv'Length = 4
-                    and then Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
-                  then
-                     case Argv (Argv'Last) is
-                        when '0' =>
-                           Current_Verbosity := Prj.Default;
-                        when '1' =>
-                           Current_Verbosity := Prj.Medium;
-                        when '2' =>
-                           Current_Verbosity := Prj.High;
-                        when others =>
-                           Fail ("Invalid switch: " & Argv.all);
-                     end case;
+                  elsif Argv (Argv'First + 1 .. Argv'First + 2) = "vP" then
+                     if Argv'Length = 4
+                          and then Argv (Argv'Last) in '0' .. '2'
+                     then
+                        case Argv (Argv'Last) is
+                           when '0' =>
+                              Current_Verbosity := Prj.Default;
+                           when '1' =>
+                              Current_Verbosity := Prj.Medium;
+                           when '2' =>
+                              Current_Verbosity := Prj.High;
+                           when others =>
+
+                              --  Cannot happen
+
+                              raise Program_Error;
+                        end case;
+                     else
+                        Fail ("invalid verbosity level: "
+                                & Argv (Argv'First + 3 .. Argv'Last));
+                     end if;
 
                      Remove_Switch (Arg_Num);
 

gcc/ada/make.adb

@@ -7825,11 +7825,12 @@ package body Make is
 
          --  -vPx  (verbosity of the parsing of the project files)
 
-         elsif Argv'Last = 4
-           and then Argv (2 .. 3) = "vP"
-           and then Argv (4) in '0' .. '2'
-         then
-            if And_Save then
+         elsif Argv (2 .. 3) = "vP" then
+            if Argv'Last /= 4 or else Argv (4) not in '0' .. '2' then
+               Make_Failed
+                 ("invalid verbosity level " & Argv (4 .. Argv'Last));
+
+            elsif And_Save then
                case Argv (4) is
                   when '0' =>
                      Current_Verbosity := Prj.Default;

gcc/ada/sem_warn.adb

@@ -472,32 +472,41 @@ package body Sem_Warn is
                return Abandon;
             end if;
 
-            --  If we appear in the context of a procedure call, then also
-            --  abandon, since there may be issues of non-visible side
-            --  effects going on in the call.
+            --  If the condition contains a function call, we consider it may
+            --  be modified by side-effects from a procedure call. Otherwise,
+            --  we consider the condition may not be modified, although that
+            --  might happen if Variable is itself a by-reference parameter,
+            --  and the procedure called modifies the global object referred to
+            --  by Variable, but we actually prefer to issue a warning in this
+            --  odd case. Note that the case where the procedure called has
+            --  visibility over Variable is treated in another case below.
+
+            if Function_Call_Found then
+               declare
+                  P : Node_Id;
 
-            declare
-               P : Node_Id;
+               begin
+                  P := N;
+                  loop
+                     P := Parent (P);
+                     exit when P = Loop_Statement;
 
-            begin
-               P := N;
-               loop
-                  P := Parent (P);
-                  exit when P = Loop_Statement;
-
-                  --  Abandon if at procedure call, or something strange is
-                  --  going on (perhaps a node with no parent that should
-                  --  have one but does not?) As always, for a warning we
-                  --  prefer to just abandon the warning than get into the
-                  --  business of complaining about the tree structure here!
-
-                  if No (P) or else Nkind (P) = N_Procedure_Call_Statement then
-                     return Abandon;
-                  end if;
-               end loop;
-            end;
+                     --  Abandon if at procedure call, or something strange is
+                     --  going on (perhaps a node with no parent that should
+                     --  have one but does not?) As always, for a warning we
+                     --  prefer to just abandon the warning than get into the
+                     --  business of complaining about the tree structure here!
+
+                     if No (P)
+                       or else Nkind (P) = N_Procedure_Call_Statement
+                     then
+                        return Abandon;
+                     end if;
+                  end loop;
+               end;
+            end if;
 
-            --  Reference to variable renaming variable in question
+         --  Reference to variable renaming variable in question
 
          elsif Is_Entity_Name (N)
            and then Present (Entity (N))
@@ -509,7 +518,7 @@ package body Sem_Warn is
          then
             return Abandon;
 
-            --  Call to subprogram
+         --  Call to subprogram
 
          elsif Nkind (N) in N_Subprogram_Call then