errout.ads: Comment clarification

2007-10-15  Robert Dewar  <dewar@adacore.com>

	* errout.ads: Comment clarification

	* exp_ch4.adb (Expand_N_Allocator): Code cleanup.
	(Expand_N_Op_Eq): Improve handling of array equality with -gnatVa

	* lib.ads: Comment update

	* init.c: Minor reformatting.

	* sem_attr.adb: Minor formatting

	* osint-b.ads: Minor reformatting

	* sem_ch9.adb: Implement -gnatd.I switch

	* g-comlin.adb: (Start): Fix handling of empty command line.

	* gnatcmd.adb (GNATCmd): Do not put the -rules in the -cargs section,
	even when -rules follows the -cargs section.

From-SVN: r129343

gcc/ada/errout.ads

@@ -670,6 +670,8 @@ package Errout is
    --  is posted (with the same effect as Error_Msg_N (Msg, N) if and only
    --  if Eflag is True and if the node N is within the main extended source
    --  unit and comes from source. Typically this is a warning mode flag.
+   --  This routine can only be called during semantic analysis. It may not
+   --  be called during parsing.
 
    procedure Change_Error_Text (Error_Id : Error_Msg_Id; New_Msg : String);
    --  The error message text of the message identified by Id is replaced by

gcc/ada/exp_ch4.adb

@@ -3189,27 +3189,21 @@ package body Exp_Ch4 is
             Nod  := N;
             Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
 
-            --  Construct argument list for the initialization routine call.
-            --  The CPP constructor needs the address directly
+            --  Construct argument list for the initialization routine call
 
-            if Is_CPP_Class (T) then
-               Arg1 := New_Reference_To (Temp, Loc);
-               Temp_Type := T;
-
-            else
-               Arg1 := Make_Explicit_Dereference (Loc,
+            Arg1 :=
+              Make_Explicit_Dereference (Loc,
                 Prefix => New_Reference_To (Temp, Loc));
             Set_Assignment_OK (Arg1);
             Temp_Type := PtrT;
 
-               --  The initialization procedure expects a specific type. if
-               --  the context is access to class wide, indicate that the
-               --  object being allocated has the right specific type.
+            --  The initialization procedure expects a specific type. if the
+            --  context is access to class wide, indicate that the object being
+            --  allocated has the right specific type.
 
             if Is_Class_Wide_Type (Dtyp) then
                Arg1 := Unchecked_Convert_To (T, Arg1);
             end if;
-            end if;
 
             --  If designated type is a concurrent type or if it is private
             --  type whose definition is a concurrent type, the first argument
@@ -3405,11 +3399,6 @@ package body Exp_Ch4 is
                 Expression          => Nod);
 
             Set_Assignment_OK (Temp_Decl);
-
-            if Is_CPP_Class (T) then
-               Set_Aliased_Present (Temp_Decl);
-            end if;
-
             Insert_Action (N, Temp_Decl, Suppress => All_Checks);
 
             --  If the designated type is a task type or contains tasks,
@@ -3480,15 +3469,7 @@ package body Exp_Ch4 is
                end if;
             end if;
 
-            if Is_CPP_Class (T) then
-               Rewrite (N,
-                 Make_Attribute_Reference (Loc,
-                   Prefix => New_Reference_To (Temp, Loc),
-                   Attribute_Name => Name_Unchecked_Access));
-            else
             Rewrite (N, New_Reference_To (Temp, Loc));
-            end if;
-
             Analyze_And_Resolve (N, PtrT);
          end if;
       end;
@@ -5125,10 +5106,13 @@ package body Exp_Ch4 is
 
       elsif Is_Array_Type (Typl) then
 
-         --  If we are doing full validity checking, then expand out array
-         --  comparisons to make sure that we check the array elements.
+         --  If we are doing full validity checking, and it is possible for the
+         --  array elements to be invalid then expand out array comparisons to
+         --  make sure that we check the array elements.
 
-         if Validity_Check_Operands then
+         if Validity_Check_Operands
+           and then not Is_Known_Valid (Component_Type (Typl))
+         then
             declare
                Save_Force_Validity_Checks : constant Boolean :=
                                               Force_Validity_Checks;
@@ -5828,6 +5812,8 @@ package body Exp_Ch4 is
       Rhi : Uint;
       ROK : Boolean;
 
+      pragma Warnings (Off, Lhi);
+
    begin
       Binary_Op_Validity_Checks (N);
 
@@ -6416,6 +6402,8 @@ package body Exp_Ch4 is
       Rhi : Uint;
       ROK : Boolean;
 
+      pragma Warnings (Off, Lhi);
+
    begin
       Binary_Op_Validity_Checks (N);
 

gcc/ada/g-comlin.adb

@@ -1606,6 +1606,11 @@ package body GNAT.Command_Line is
       Expanded : Boolean)
    is
    begin
+      if Cmd.Expanded = null then
+         Iter.List := null;
+         return;
+      end if;
+
       --  Coalesce the switches as much as possible
 
       if not Expanded

gcc/ada/gnatcmd.adb

@@ -711,6 +711,7 @@ procedure GNATCmd is
 
    procedure Delete_Temp_Config_Files is
       Success : Boolean;
+      pragma Warnings (Off, Success);
 
    begin
       if not Keep_Temporary_Files then
@@ -2017,20 +2018,81 @@ begin
 
             for J in 1 .. First_Switches.Last loop
                if First_Switches.Table (J).all = "-cargs" then
-                  for K in J + 1 .. First_Switches.Last loop
+                  declare
+                     K    : Positive;
+                     Last : Natural;
+
+                  begin
+                     --  Move the switches that are before -rules when the
+                     --  command is CHECK.
+
+                     K := J + 1;
+                     while K <= First_Switches.Last
+                       and then
+                        (The_Command /= Check
+                           or else First_Switches.Table (K).all /= "-rules")
+                     loop
                         Add_To_Carg_Switches (First_Switches.Table (K));
+                        K := K + 1;
                      end loop;
+
+                     if K > First_Switches.Last then
                         First_Switches.Set_Last (J - 1);
+
+                     else
+                        Last := J - 1;
+                        while K <= First_Switches.Last loop
+                           Last := Last + 1;
+                           First_Switches.Table (Last) :=
+                             First_Switches.Table (K);
+                           K := K + 1;
+                        end loop;
+
+                        First_Switches.Set_Last (Last);
+                     end if;
+                  end;
+
                   exit;
                end if;
             end loop;
 
             for J in 1 .. Last_Switches.Last loop
                if Last_Switches.Table (J).all = "-cargs" then
-                  for K in J + 1 .. Last_Switches.Last loop
+                  declare
+                     K    : Positive;
+                     Last : Natural;
+
+                  begin
+                     --  Move the switches that are before -rules when the
+                     --  command is CHECK.
+
+                     K := J + 1;
+                     while K <= Last_Switches.Last
+                       and then
+                        (The_Command /= Check
+                         or else
+                         Last_Switches.Table (K).all /= "-rules")
+                     loop
                         Add_To_Carg_Switches (Last_Switches.Table (K));
+                        K := K + 1;
                      end loop;
+
+                     if K > Last_Switches.Last then
                         Last_Switches.Set_Last (J - 1);
+
+                     else
+                        Last := J - 1;
+                        while K <= Last_Switches.Last loop
+                           Last := Last + 1;
+                           Last_Switches.Table (Last) :=
+                             Last_Switches.Table (K);
+                           K := K + 1;
+                        end loop;
+
+                        Last_Switches.Set_Last (Last);
+                     end if;
+                  end;
+
                   exit;
                end if;
             end loop;

gcc/ada/lib.ads

@@ -509,10 +509,11 @@ package Lib is
    --  Same function as above but argument is a source pointer
 
    function Earlier_In_Extended_Unit (S1, S2 : Source_Ptr) return Boolean;
-   --  Given two Sloc values  for which In_Same_Extended_Unit is true,
-   --  determine if S1 appears before S2. Returns True if S1 appears before
-   --  S2, and False otherwise. The result is undefined if S1 and S2 are
-   --  not in the same extended unit.
+   --  Given two Sloc values for which In_Same_Extended_Unit is true, determine
+   --  if S1 appears before S2. Returns True if S1 appears before S2, and False
+   --  otherwise. The result is undefined if S1 and S2 are not in the same
+   --  extended unit. Note: this routine will not give reliable results if
+   --  called after Sprint has been called with -gnatD set.
 
    function Compilation_Switches_Last return Nat;
    --  Return the count of stored compilation switches

gcc/ada/osint-b.ads

@@ -79,7 +79,6 @@ package Osint.B is
    --  buffers etc from writes by Write_Binder_Info.
 
    procedure Set_Current_File_Name_Index (To : Int);
-   --  Set the value of Current_File_Name_Index (in the private part of Osint)
-   --  to To.
+   --  Set value of Current_File_Name_Index (in private part of Osint) to To
 
 end Osint.B;

gcc/ada/sem_attr.adb

@@ -7905,6 +7905,10 @@ package body Sem_Attr is
             Process_Partition_Id (N);
             return;
 
+         ------------------
+         -- Pool_Address --
+         ------------------
+
          when Attribute_Pool_Address =>
             Resolve (P);
 

gcc/ada/sem_ch9.adb

@@ -1399,7 +1399,7 @@ package body Sem_Ch9 is
          Generate_Reference (Entry_Id, Entry_Name);
 
          if Present (First_Formal (Entry_Id)) then
-            if VM_Target = JVM_Target then
+            if VM_Target = JVM_Target and then not Inspector_Mode then
                Error_Msg_N
                  ("arguments unsupported in requeue statement",
                   First_Formal (Entry_Id));