From 972fb59e54c1df4e076e113721be78ff6ce1c391 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 31 Jul 2014 11:51:11 +0200 Subject: [PATCH] [multiple changes] 2014-07-31 Ed Schonberg * sem_util.adb (Has_Preelaborable_Initialization): Check that type is tagged before checking whether a user-defined Initialize procedure is present. 2014-07-31 Gary Dismukes * a-ngelfu.ads (Sqrt): Augment postcondition. 2014-07-31 Pascal Obry * prj-nmsc.adb (Check_Library_Attributes): An aggegate library directory and ALI directory must be different than all object and library directories of aggregated projects. 2014-07-31 Vincent Celier * prj-pars.adb, prj-conf.ads, prj-conf.adb (Locate_Runtime): Move spec to package body, as it is not called from outside. Remove argument Project_Tree, no longer used. When runtime cannot be found, call Raise_Invalid_Config instead of failing the program. From-SVN: r213330 --- gcc/ada/ChangeLog | 23 ++++++++++++++++ gcc/ada/a-ngelfu.ads | 20 ++++++++++++-- gcc/ada/prj-conf.adb | 15 +++++++--- gcc/ada/prj-conf.ads | 9 ------ gcc/ada/prj-nmsc.adb | 77 ++++++++++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/prj-pars.adb | 6 ++-- gcc/ada/sem_util.adb | 6 +++- 7 files changed, 136 insertions(+), 20 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bac79b1..4f9ed7c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2014-07-31 Ed Schonberg + + * sem_util.adb (Has_Preelaborable_Initialization): Check that + type is tagged before checking whether a user-defined Initialize + procedure is present. + +2014-07-31 Gary Dismukes + + * a-ngelfu.ads (Sqrt): Augment postcondition. + +2014-07-31 Pascal Obry + + * prj-nmsc.adb (Check_Library_Attributes): An aggegate library + directory and ALI directory must be different than all object + and library directories of aggregated projects. + +2014-07-31 Vincent Celier + + * prj-pars.adb, prj-conf.ads, prj-conf.adb (Locate_Runtime): Move spec + to package body, as it is not called from outside. Remove argument + Project_Tree, no longer used. When runtime cannot be found, + call Raise_Invalid_Config instead of failing the program. + 2014-07-31 Robert Dewar * bindgen.adb (Gen_Output_File_Ada): Generate pragma Suppress diff --git a/gcc/ada/a-ngelfu.ads b/gcc/ada/a-ngelfu.ads index 0d55101..5569923 100644 --- a/gcc/ada/a-ngelfu.ads +++ b/gcc/ada/a-ngelfu.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2012-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2012-2014, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -41,8 +41,22 @@ package Ada.Numerics.Generic_Elementary_Functions is function Sqrt (X : Float_Type'Base) return Float_Type'Base with Post => Sqrt'Result >= 0.0 - and then (if X = 0.0 then Sqrt'Result = 0.0) - and then (if X = 1.0 then Sqrt'Result = 1.0); + + and then (if X = 0.0 then Sqrt'Result = 0.0) + + and then (if X = 1.0 then Sqrt'Result = 1.0) + + -- If X is positive, the result of Sqrt is positive. This property is + -- useful in particular for static analysis. The property that X is + -- positive is not expressed as (X > 0), as the value X may be held in + -- registers that have larger range and precision on some architecture + + -- (for example, on x86 using x387 FPU, as opposed to SSE2). So, it + -- might be possible for X to be 2.0**(-5000) or so, which could cause + -- the number to compare as greater than 0, but Sqrt would still return + -- a zero result. + + and then (if X >= Float_Type'Succ (0.0) then Sqrt'Result > 0.0); function Log (X : Float_Type'Base) return Float_Type'Base with diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 1becd70..b500e7b 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -64,6 +64,14 @@ package body Prj.Conf is -- Stores the runtime names for the various languages. This is in general -- set from a --RTS command line option. + procedure Locate_Runtime + (Language : Name_Id; + Env : Prj.Tree.Environment); + -- If RTS_Name is a base name (a name without path separator), then + -- do nothing. Otherwise, convert it to an absolute path (possibly by + -- searching it in the project path) and call Set_Runtime_For with the + -- absolute path. Raise Invalid_Config if the path does not exist. + ----------------------- -- Local_Subprograms -- ----------------------- @@ -721,7 +729,7 @@ package body Prj.Conf is Set_Runtime_For (Name_Ada, Name_Buffer (7 .. Name_Len)); - Locate_Runtime (Name_Ada, Project_Tree, Env); + Locate_Runtime (Name_Ada, Env); end if; elsif Name_Len > 7 @@ -748,7 +756,7 @@ package body Prj.Conf is if not Runtime_Name_Set_For (Lang) then Set_Runtime_For (Lang, RTS); - Locate_Runtime (Lang, Project_Tree, Env); + Locate_Runtime (Lang, Env); end if; end; end if; @@ -1518,7 +1526,6 @@ package body Prj.Conf is procedure Locate_Runtime (Language : Name_Id; - Project_Tree : Prj.Project_Tree_Ref; Env : Prj.Tree.Environment) is function Is_Base_Name (Path : String) return Boolean; @@ -1555,7 +1562,7 @@ package body Prj.Conf is Find_Rts_In_Path (Env.Project_Path, RTS_Name); if Full_Path = null then - Fail_Program (Project_Tree, "cannot find RTS " & RTS_Name); + Raise_Invalid_Config ("cannot find RTS " & RTS_Name); end if; Set_Runtime_For (Language, Normalize_Pathname (Full_Path.all)); diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads index df830ad..029310f 100644 --- a/gcc/ada/prj-conf.ads +++ b/gcc/ada/prj-conf.ads @@ -216,13 +216,4 @@ package Prj.Conf is function Runtime_Name_Set_For (Language : Name_Id) return Boolean; -- Returns True only if Set_Runtime_For has been called for the Language - procedure Locate_Runtime - (Language : Name_Id; - Project_Tree : Prj.Project_Tree_Ref; - Env : Prj.Tree.Environment); - -- If RTS_Name is a base name (a name without path separator), then - -- do nothing. Otherwise, convert it to an absolute path (possibly by - -- searching it in the project path) and call Set_Runtime_For with the - -- absolute path. Fail the program if the path does not exist. - end Prj.Conf; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 19c12de..96d3777 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -3028,6 +3028,76 @@ package body Prj.Nmsc is procedure Check_Library (Proj : Project_Id; Extends : Boolean); -- Check if an imported or extended project if also a library project + procedure Check_Aggregate_Library_Dirs; + + ---------------------------------- + -- Check_Aggregate_Library_Dirs -- + ---------------------------------- + + procedure Check_Aggregate_Library_Dirs is + procedure Process_Aggregate (Proj : Project_Id); + + procedure Process_Aggregate (Proj : Project_Id) is + + Agg : Aggregated_Project_List := Proj.Aggregated_Projects; + + begin + while Agg /= null loop + Error_Msg_Name_1 := Agg.Project.Name; + + if Agg.Project.Qualifier /= Aggregate_Library and then + Project.Library_ALI_Dir.Name + = Agg.Project.Object_Directory.Name + then + Error_Msg + (Data.Flags, + "aggregate library 'A'L'I directory cannot be shared with" + & " object directory of aggregated project %%", + The_Lib_Kind.Location, Project); + + elsif Project.Library_ALI_Dir.Name + = Agg.Project.Library_Dir.Name + then + Error_Msg + (Data.Flags, + "aggregate library 'A'L'I directory cannot be shared with" + & " library directory of aggregated project %%", + The_Lib_Kind.Location, Project); + + elsif Agg.Project.Qualifier /= Aggregate_Library and then + Project.Library_Dir.Name + = Agg.Project.Object_Directory.Name + then + Error_Msg + (Data.Flags, + "aggregate library directory cannot be shared with" + & " object directory of aggregated project %%", + The_Lib_Kind.Location, Project); + + elsif Project.Library_Dir.Name + = Agg.Project.Library_Dir.Name + then + Error_Msg + (Data.Flags, + "aggregate library directory cannot be shared with" + & " library directory of aggregated project %%", + The_Lib_Kind.Location, Project); + end if; + + if Agg.Project.Qualifier = Aggregate_Library then + Process_Aggregate (Agg.Project); + end if; + + Agg := Agg.Next; + end loop; + end Process_Aggregate; + + begin + if Project.Qualifier = Aggregate_Library then + Process_Aggregate (Project); + end if; + end Check_Aggregate_Library_Dirs; + ------------------- -- Check_Library -- ------------------- @@ -3745,6 +3815,13 @@ package body Prj.Nmsc is Continuation := Continuation_String'Access; end if; + -- Check that aggregated libraries do not share the aggregate + -- Library_ALI_Dir. + + if Project.Qualifier = Aggregate_Library then + Check_Aggregate_Library_Dirs; + end if; + if Project.Library and not Data.In_Aggregate_Lib then -- Record the library name diff --git a/gcc/ada/prj-pars.adb b/gcc/ada/prj-pars.adb index 7fbce49..a37e13a 100644 --- a/gcc/ada/prj-pars.adb +++ b/gcc/ada/prj-pars.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2014, 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- -- @@ -103,8 +103,8 @@ package body Prj.Pars is Success := The_Project /= No_Project; exception - when Invalid_Config => - Success := False; + when E : Invalid_Config => + Osint.Fail (Exception_Message (E)); end; Prj.Err.Finalize; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index af04384..f6c150f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -8189,10 +8189,13 @@ package body Sem_Util is end if; -- Check specifically for 10.2.1(11.4/2) exception: a controlled type - -- with a user defined Initialize procedure does not have PI. + -- with a user defined Initialize procedure does not have PI. If + -- the type is untagged, the control primitives come from a component + -- that has already been checked. if Has_PE and then Is_Controlled (E) + and then Is_Tagged_Type (E) and then Has_Overriding_Initialize (E) then Has_PE := False; @@ -16456,6 +16459,7 @@ package body Sem_Util is Stmt := Original_Node (N); end if; + -- and then Ekind (Entity (Identifier (Stmt))) = E_Loop return Nkind (Stmt) = N_Loop_Statement and then Present (Identifier (Stmt)) -- 2.7.4