diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 704f22197301c0a02e39b87256b4b5dd0bb558f5..f58181eb018efc2ff579d73f2ffaebbc7a4b05b8 100644
--- a/gcc/ada/errout.ads
+++ b/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
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index bd5ddfb63c2574ecf29636debf338fb36c02a1fa..c1b88bef948e636cc135ec466529ff068250828e 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -3189,26 +3189,20 @@ 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;
+ Arg1 :=
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Reference_To (Temp, Loc));
+ Set_Assignment_OK (Arg1);
+ Temp_Type := PtrT;
- else
- 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;
+ if Is_Class_Wide_Type (Dtyp) then
+ Arg1 := Unchecked_Convert_To (T, Arg1);
end if;
-- If designated type is a concurrent type or if it is private
@@ -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;
-
+ Rewrite (N, New_Reference_To (Temp, Loc));
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);
diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb
index 61a0d87da2778dd32e8af040c01b825895a18439..95b1fbe23676a213952b2e486616d2b30761448c 100644
--- a/gcc/ada/g-comlin.adb
+++ b/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
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 7ffc55853c1c73900b11ca64b161f742945a62ec..debf0c32d5c1435d8be5c0b78dbf3e286c7fb2d8 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/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
- Add_To_Carg_Switches (First_Switches.Table (K));
- end loop;
- First_Switches.Set_Last (J - 1);
+ 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
- Add_To_Carg_Switches (Last_Switches.Table (K));
- end loop;
- Last_Switches.Set_Last (J - 1);
+ 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;
@@ -2085,8 +2147,8 @@ begin
elsif The_Command = Stub then
declare
- Data : constant Prj.Project_Data :=
- Project_Tree.Projects.Table (Project);
+ Data : constant Prj.Project_Data :=
+ Project_Tree.Projects.Table (Project);
File_Index : Integer := 0;
Dir_Index : Integer := 0;
Last : constant Integer := Last_Switches.Last;
@@ -2122,7 +2184,7 @@ begin
if Spec'Length > Name_Len
and then Spec (Last - Name_Len + 1 .. Last) =
- Name_Buffer (1 .. Name_Len)
+ Name_Buffer (1 .. Name_Len)
then
Last := Last - Name_Len;
Get_Name_String
@@ -2147,7 +2209,7 @@ begin
if File_Index /= 0 then
for Index in File_Index + 1 .. Last loop
if Last_Switches.Table (Index)
- (Last_Switches.Table (Index)'First) /= '-'
+ (Last_Switches.Table (Index)'First) /= '-'
then
Dir_Index := Index;
exit;
@@ -2186,7 +2248,7 @@ begin
if The_Command = Check then
declare
- New_Last : Natural;
+ New_Last : Natural;
-- Set to rank of options preceding "-rules"
In_Rules_Switches : Boolean;
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index ba36d38458d8bf38ffa7f51e534f714eb3d24261..3fa59772645661d101b9e388e4692c3c56ff3269 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -1510,7 +1510,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
break;
}
- Raise_From_Signal_Handler (exception, msg);
+ Raise_From_Signal_Handler (exception, msg);
}
long
diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads
index 19cfa1841acd797e883862ea7458cd574cc14f12..bff54f09ec1f444a73cc4cd13263658a47fa5b78 100644
--- a/gcc/ada/lib.ads
+++ b/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
diff --git a/gcc/ada/osint-b.ads b/gcc/ada/osint-b.ads
index a0fa2bba15e5358f7276cada49d428c31a36d589..2f9460c624a3513319730b1ec8d200a318c561be 100644
--- a/gcc/ada/osint-b.ads
+++ b/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;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 903aad050a3239645abdb49745cfcd27fd6107b6..6c3e3dcc3ee45f53da705884840e19020415fc1a 100644
--- a/gcc/ada/sem_attr.adb
+++ 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);
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index 5483e9a6e14f404041df95be267ac63fd93f107b..b61e58af5749b600f84fcb7b1a3d71602c7c35c6 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/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));