+2014-07-31 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <dismukes@adacore.com>
+
+ * a-ngelfu.ads (Sqrt): Augment postcondition.
+
+2014-07-31 Pascal Obry <obry@adacore.com>
+
+ * 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 <celier@adacore.com>
+
+ * 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 <dewar@adacore.com>
* bindgen.adb (Gen_Output_File_Ada): Generate pragma Suppress
-- --
-- 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 --
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
-- 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 --
-----------------------
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
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;
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;
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));
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;
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 --
-------------------
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
-- --
-- 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- --
Success := The_Project /= No_Project;
exception
- when Invalid_Config =>
- Success := False;
+ when E : Invalid_Config =>
+ Osint.Fail (Exception_Message (E));
end;
Prj.Err.Finalize;
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;
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))
projects / thirdparty / gcc.git / commitdiff
