From ccd6f4147ce06511cbcc8df80bdcea21d8afe639 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 22 May 2015 14:45:14 +0200 Subject: [PATCH] [multiple changes] 2015-05-22 Robert Dewar * sem_ch12.adb, prj.ads, makeutl.ads, sem_ch6.adb, prj-nmsc.adb, prj-conf.adb, sem_disp.adb: Minor reformatting. 2015-05-22 Vincent Celier * clean.adb (Parse_Cmd_Line): For native gnatclean, check for switch -P and, if found and gprclean is available, invoke silently gprclean. * make.adb (Initialize): For native gnatmake, check for switch -P and, if found and gprbuild is available, invoke silently gprbuild. 2015-05-22 Eric Botcazou * sem_ch13.adb (Validate_Unchecked_Conversions): Also issue specific warning for discrete types when the source is larger than the target. From-SVN: r223555 --- gcc/ada/ChangeLog | 19 +++++++++++++++ gcc/ada/clean.adb | 55 +++++++++++++++++++++++++++++++++++++++++--- gcc/ada/make.adb | 51 +++++++++++++++++++++++++++++++++++++++- gcc/ada/makeutl.ads | 2 +- gcc/ada/prj-conf.adb | 6 ++--- gcc/ada/prj-nmsc.adb | 5 ++-- gcc/ada/prj.ads | 2 +- gcc/ada/sem_ch12.adb | 14 +++++++---- gcc/ada/sem_ch13.adb | 19 ++++++++++++--- gcc/ada/sem_ch6.adb | 4 +--- gcc/ada/sem_disp.adb | 11 ++++----- 11 files changed, 159 insertions(+), 29 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3777b63b0f0..bb5f5e73202 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2015-05-22 Robert Dewar + + * sem_ch12.adb, prj.ads, makeutl.ads, sem_ch6.adb, prj-nmsc.adb, + prj-conf.adb, sem_disp.adb: Minor reformatting. + +2015-05-22 Vincent Celier + + * clean.adb (Parse_Cmd_Line): For native gnatclean, check + for switch -P and, if found and gprclean is available, invoke + silently gprclean. + * make.adb (Initialize): For native gnatmake, check for switch -P + and, if found and gprbuild is available, invoke silently gprbuild. + +2015-05-22 Eric Botcazou + + * sem_ch13.adb (Validate_Unchecked_Conversions): Also issue + specific warning for discrete types when the source is larger + than the target. + 2015-05-22 Ed Schonberg * einfo.ads, einfo.adb (Incomplete_Actuals): New attribute of diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 6a7f7fa275b..e410c3ba88a 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2015, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1629,6 +1629,55 @@ package body Clean is Check_Version_And_Help ("GNATCLEAN", "2003"); + -- First, for native gnatclean, check for switch -P and, if found and + -- gprclean is available, silently invoke gprclean. + + Find_Program_Name; + + if Name_Buffer (1 .. Name_Len) = "gnatclean" then + declare + Call_Gprclean : Boolean := False; + + begin + for J in 1 .. Argument_Count loop + declare + Arg : constant String := Argument (J); + begin + if Arg'Length >= 2 + and then Arg (Arg'First .. Arg'First + 1) = "-P" + then + Call_Gprclean := True; + exit; + end if; + end; + end loop; + + if Call_Gprclean then + declare + Gprclean : String_Access := + Locate_Exec_On_Path (Exec_Name => "gprclean"); + Args : Argument_List (1 .. Argument_Count); + Success : Boolean; + + begin + if Gprclean /= null then + for J in 1 .. Argument_Count loop + Args (J) := new String'(Argument (J)); + end loop; + + Spawn (Gprclean.all, Args, Success); + + Free (Gprclean); + + if Success then + Exit_Program (E_Success); + end if; + end if; + end; + end if; + end; + end if; + Index := 1; while Index <= Last loop declare @@ -1687,10 +1736,10 @@ package body Clean is Bad_Argument; end if; - when 'c' => + when 'c' => Compile_Only := True; - when 'D' => + when 'D' => if Object_Directory_Path /= null then Fail ("duplicate -D switch"); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 8fc4763e71c..d3324e70c79 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -6442,6 +6442,55 @@ package body Make is -- Scan again the switch and arguments, now that we are sure that they -- do not include --version or --help. + -- First, for native gnatmake, check for switch -P and, if found and + -- gprbuild is available, silently invoke gprbuild. + + Find_Program_Name; + + if Name_Buffer (1 .. Name_Len) = "gnatmake" then + declare + Call_Gprbuild : Boolean := False; + + begin + for J in 1 .. Argument_Count loop + declare + Arg : constant String := Argument (J); + begin + if Arg'Length >= 2 + and then Arg (Arg'First .. Arg'First + 1) = "-P" + then + Call_Gprbuild := True; + exit; + end if; + end; + end loop; + + if Call_Gprbuild then + declare + Gprbuild : String_Access := + Locate_Exec_On_Path (Exec_Name => "gprbuild"); + Args : Argument_List (1 .. Argument_Count); + Success : Boolean; + + begin + if Gprbuild /= null then + for J in 1 .. Argument_Count loop + Args (J) := new String'(Argument (J)); + end loop; + + Spawn (Gprbuild.all, Args, Success); + + Free (Gprbuild); + + if Success then + Exit_Program (E_Success); + end if; + end if; + end; + end if; + end; + end if; + Scan_Args : for Next_Arg in 1 .. Argument_Count loop Scan_Make_Arg (Env, Argument (Next_Arg), And_Save => True); end loop Scan_Args; diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 45442c85c26..e012e9426ba 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -74,7 +74,7 @@ package Makeutl is Root_Dir_Option : constant String := "--root-dir"; -- The root directory under which all artifacts (objects, library, ali) -- directory are to be found for the current compilation. This directory - -- will be use to relocate artifacts based on this directory. If this + -- will be used to relocate artifacts based on this directory. If this -- option is not specificed the default value is the directory of the -- main project. diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 8c55f2a515b..e48b7fba016 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -973,7 +973,7 @@ package body Prj.Conf is Add_Str_To_Name_Buffer (Build_Tree_Dir.all); if Get_Name_String (Conf_Project.Directory.Display_Name)'Length - < Root_Dir'Length + < Root_Dir'Length then Raise_Invalid_Config ("cannot relocate deeper than object directory"); @@ -994,8 +994,8 @@ package body Prj.Conf is else if Build_Tree_Dir /= null then if Get_Name_String - (Conf_Project.Directory.Display_Name)'Length - < Root_Dir'Length + (Conf_Project.Directory.Display_Name)'Length < + Root_Dir'Length then Raise_Invalid_Config ("cannot relocate deeper than object directory"); diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index a34b5a1b4b9..c7a5d3c92c8 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -5589,8 +5589,8 @@ package body Prj.Nmsc is end if; end if; - elsif not No_Sources and then - (Subdirs /= null or else Build_Tree_Dir /= null) + elsif not No_Sources + and then (Subdirs /= null or else Build_Tree_Dir /= null) then Name_Len := 1; Name_Buffer (1) := '.'; @@ -6232,6 +6232,7 @@ package body Prj.Nmsc is else if Build_Tree_Dir /= null and then Create /= "" then + -- Issue a warning that we cannot relocate absolute obj dir Err_Vars.Error_Msg_File_1 := Name; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 29a718eb04b..4af4f3cfb88 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -68,7 +68,7 @@ package Prj is Root_Dir : String_Ptr := null; -- When using out-of-tree build we need to keep information about the root -- directory of artifacts to properly relocate them. Note that the root - -- directory is not necessary the directory of the main project. + -- directory is not necessarily the directory of the main project. type Library_Support is (None, Static_Only, Full); -- Support for Library Project File. diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 12f76b3af46..f38ff5fa7c1 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -830,6 +830,7 @@ package body Sem_Ch12 is -- later, when the expected types are known, but names have to be captured -- before installing parents of generics, that are not visible for the -- actuals themselves. + -- -- If Inst is present, it is the entity of the package instance. This -- entity is marked as having a limited_view actual when some actual is -- a limited view. This is used to place the instance body properly.. @@ -3601,7 +3602,8 @@ package body Sem_Ch12 is Generate_Definition (Act_Decl_Id); Set_Ekind (Act_Decl_Id, E_Package); - -- Initialize list of incomplete actuals before analysis. + -- Initialize list of incomplete actuals before analysis + Set_Incomplete_Actuals (Act_Decl_Id, New_Elmt_List); Preanalyze_Actuals (N, Act_Decl_Id); @@ -8883,17 +8885,19 @@ package body Sem_Ch12 is -- the instance body. declare - Elmt : Elmt_Id; - F_T : Node_Id; - Typ : Entity_Id; + Elmt : Elmt_Id; + F_T : Node_Id; + Typ : Entity_Id; begin Elmt := First_Elmt (Incomplete_Actuals (Act_Id)); while Present (Elmt) loop Typ := Node (Elmt); + if From_Limited_With (Typ) then Typ := Non_Limited_View (Typ); end if; + Ensure_Freeze_Node (Typ); F_T := Freeze_Node (Typ); @@ -13356,7 +13360,7 @@ package body Sem_Ch12 is Analyze (Act); if Is_Entity_Name (Act) - and then Is_Type (Entity (Act)) + and then Is_Type (Entity (Act)) and then From_Limited_With (Entity (Act)) then Append_Elmt (Entity (Act), Incomplete_Actuals (Inst)); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 474aa5e7c6f..7f951bcb729 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -13483,9 +13483,22 @@ package body Sem_Ch13 is end if; else pragma Assert (Source_Siz > Target_Siz); - Error_Msg - ("\?z?^ trailing bits of source will be ignored!", - Eloc); + if Is_Discrete_Type (Source) then + if Bytes_Big_Endian then + Error_Msg + ("\?z?^ low order bits of source will be " + & "ignored!", Eloc); + else + Error_Msg + ("\?z?^ high order bits of source will be " + & "ignored!", Eloc); + end if; + + else + Error_Msg + ("\?z?^ trailing bits of source will be " + & "ignored!", Eloc); + end if; end if; end if; end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index e851346a508..fba28c362ce 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2831,9 +2831,7 @@ package body Sem_Ch6 is procedure Detect_And_Exchange (Id : Entity_Id) is Typ : constant Entity_Id := Etype (Id); begin - if From_Limited_With (Typ) - and then Has_Non_Limited_View (Typ) - then + if From_Limited_With (Typ) and then Has_Non_Limited_View (Typ) then Set_Etype (Id, Non_Limited_View (Typ)); end if; end Detect_And_Exchange; diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 273b0cd93d0..55e5dcd8686 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -818,15 +818,13 @@ package body Sem_Disp is -- (the only current case of a tag-indeterminate attribute -- is the stream Input attribute). - elsif - Nkind (Original_Node (Actual)) = N_Attribute_Reference + elsif Nkind (Original_Node (Actual)) = N_Attribute_Reference then Func := Empty; -- Ditto if it is an explicit dereference. - elsif - Nkind (Original_Node (Actual)) = N_Explicit_Dereference + elsif Nkind (Original_Node (Actual)) = N_Explicit_Dereference then Func := Empty; @@ -835,9 +833,8 @@ package body Sem_Disp is else Func := - Entity (Name - (Original_Node - (Expression (Original_Node (Actual))))); + Entity (Name (Original_Node + (Expression (Original_Node (Actual))))); end if; if Present (Func) and then Is_Abstract_Subprogram (Func) then -- 2.30.2