From 8f199ad0416c7b2779da7eaabd9f00c4f936502b Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 15 Oct 2007 13:58:20 +0000 Subject: [PATCH] 2007-10-15 Robert Dewar * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@129343 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/errout.ads | 2 ++ gcc/ada/exp_ch4.adb | 56 +++++++++++++-------------------- gcc/ada/g-comlin.adb | 5 +++ gcc/ada/gnatcmd.adb | 88 ++++++++++++++++++++++++++++++++++++++++++++-------- gcc/ada/init.c | 2 +- gcc/ada/lib.ads | 9 +++--- gcc/ada/osint-b.ads | 3 +- gcc/ada/sem_attr.adb | 4 +++ gcc/ada/sem_ch9.adb | 2 +- 9 files changed, 116 insertions(+), 55 deletions(-) diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 704f2219730..f58181eb018 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 bd5ddfb63c2..c1b88bef948 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 61a0d87da27..95b1fbe2367 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 7ffc55853c1..debf0c32d5c 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 ba36d38458d..3fa59772645 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 19cfa1841ac..bff54f09ec1 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 a0fa2bba15e..2f9460c624a 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 903aad050a3..6c3e3dcc3ee 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 5483e9a6e14..b61e58af574 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)); -- 2.11.0