OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

errout.ads: Comment clarification

Browse Source 
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
This commit is contained in:
Robert Dewar 2007-10-15 15:58:20 +02:00 committed by Arnaud Charlet
parent 569f538b9d
commit 1033834f3b
9 changed files with 116 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gcc/ada/errout.ads
View File

@ -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

56
gcc/ada/exp_ch4.adb
View File

@ -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);

5
gcc/ada/g-comlin.adb
View File

@ -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

88
gcc/ada/gnatcmd.adb
View File

@ -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;

2
gcc/ada/init.c
View File

@ -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

9
gcc/ada/lib.ads
View File

@ -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

3
gcc/ada/osint-b.ads
View File

@ -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;

4
gcc/ada/sem_attr.adb
View File

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

2
gcc/ada/sem_ch9.adb
View File

@ -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));