+2011-08-04 Vincent Celier <celier@adacore.com>
+
+ * gnat_ugn.texi: Improve documentation of gnatmake switch
+ --source-info-file=.
+
+2011-08-04 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch7.adb (Make_Final_Call): Add local variable Atyp (assertion
+ type). Initialize Atyp to the appropriate type which is later checked
+ for completion. Rewrite the assertion associated with private type
+ completion.
+
+2011-08-04 Ed Falis <falis@adacore.com>
+
+ * adaint.c: Add call to vxCpuConfiguredGet for VxWorks SMP to
+ initialize the number of CPUs.
+
+2011-08-04 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_type.adb (Disambiguate): New subsidiary routine
+ In_Same_Declaration_List, to implement AI05-0020: a user-defined
+ equality on an anonymous access type whose designated type is private
+ does not lead to an ambiguity with the universal access equality
+ operator in the body or child units of the defining package. The same
+ is true for a multiplication operator on a private type completed with
+ a fixed-point-type.
+
+2011-08-04 Javier Miranda <miranda@adacore.com>
+
+ * opt.ads (Init_Or_Norm_Scalars_Config): Removed.
+ (Normalize_Scalars_Config): Removed.
+ * opt.adb
+ (Register_Opt_Config_Switches): Remove registering config values of
+ Init_Or_Norm_Scalars_Config and Normalize_Scalars_Config.
+ (Restore_Opt_Config_Switches): Remove code which restores the values of
+ Init_Or_Norm_Scalars and Normalize_Scalars. Recalculate value of
+ Init_Or_Norm_Scalars.
+ (Save_Opt_Config_Switches): Remove code which saves values of
+ Init_Or_Norm_Scalars and Normalize_Scalars.
+ (Set_Opt_Config_Switches): Remove code which restores config values of
+ Init_Or_Norm_Scalars and Normalize_Scalars. Recalculate value of
+ Init_Or_Norm_Scalars.
+
+2011-08-04 Yannick Moy <moy@adacore.com>
+
+ * frontend.adb (Frontend): remove previous patch to avoid full
+ qualification in ALFA mode.
+ * lib-xref-alfa.adb (Add_ALFA_Xrefs): use unique name for variables.
+ * sem_util.adb, sem_util.ads (Unique_Name): new function to define a
+ unique name for an entity, which could be used to identify the entity
+ across compilation units.
+
+2011-08-04 Thomas Quinot <quinot@adacore.com>
+
+ * prj-env.adb
+ (Initialize_Default_Project_Path): Add target specific directory
+ ($prefix/$target/lib/gnat) in front of project path in all cases
+ (making gnatmake's behaviour consistent with gprbuild).
+ * gnatcmd.adb, make.adb, prj-makr.adb, clean.adb:
+ Pass target name from Sdefault to project subsystem.
+ * gnatls.adb: Show new target specific default project directory.
+
+2011-08-04 Johannes Kanig <kanig@adacore.com>
+
+ * cstand.adb: Add Information to Identifier in Standard
+ (Identifer_For): Set Entity to the corresponding entity
+
2011-08-04 Sergey Rybin <rybin@adacore.com>
* gnat_ugn.texi: Update doc on gnatcheck.
#include "cacheLib.h"
#endif /* __mips_vxworks */
+/* If SMP, access vxCpuConfiguredGet */
+#ifdef _WRS_CONFIG_SMP
+#include <vxCpuLib.h>
+#endif /* _WRS_CONFIG_SMP */
+
#endif /* VxWorks */
#if (defined (__mips) && defined (__sgi)) || defined (__APPLE__)
status = LIB$GETSYI (&code, &res);
if ((status & 1) != 0)
cores = res;
+
+#elif defined (__WRS_CONFIG_SMP)
+ unsigned int vxCpuConfiguredGet (void);
+
+ cores = vxCpuConfiguredGet ();
+
#endif
return cores;
with Prj.Pars;
with Prj.Tree; use Prj.Tree;
with Prj.Util; use Prj.Util;
+with Sdefault;
with Snames;
with Switch; use Switch;
with Table;
Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
Prj.Env.Initialize_Default_Project_Path
- (Root_Environment.Project_Path, Target_Name => "");
+ (Root_Environment.Project_Path,
+ Target_Name => Sdefault.Target_Name.all);
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);
begin
Ident_Node := New_Node (N_Identifier, Stloc);
Set_Chars (Ident_Node, Chars (Standard_Entity (S)));
+ Set_Entity (Ident_Node, Standard_Entity (S));
return Ident_Node;
end Identifier_For;
For_Parent : Boolean := False) return Node_Id
is
Loc : constant Source_Ptr := Sloc (Obj_Ref);
+ Atyp : Entity_Id;
Fin_Id : Entity_Id := Empty;
Ref : Node_Id;
Utyp : Entity_Id;
if Is_Class_Wide_Type (Typ) then
Utyp := Root_Type (Typ);
+ Atyp := Utyp;
Ref := Obj_Ref;
elsif Is_Concurrent_Type (Typ) then
Utyp := Corresponding_Record_Type (Typ);
+ Atyp := Empty;
Ref := Convert_Concurrent (Obj_Ref, Typ);
elsif Is_Private_Type (Typ)
and then Is_Concurrent_Type (Full_View (Typ))
then
Utyp := Corresponding_Record_Type (Full_View (Typ));
+ Atyp := Typ;
Ref := Convert_Concurrent (Obj_Ref, Full_View (Typ));
else
Utyp := Typ;
+ Atyp := Typ;
Ref := Obj_Ref;
end if;
-- instead.
if Utyp /= Base_Type (Utyp) then
- pragma Assert (Is_Private_Type (Typ));
+ pragma Assert (Present (Atyp) and then Is_Private_Type (Atyp));
Utyp := Base_Type (Utyp);
Ref := Unchecked_Convert_To (Utyp, Ref);
-- Qualify all entity names in inner packages, package bodies, etc.,
-- except when compiling for the VM back-ends, which depend on having
-- unqualified names in certain cases and handles the generation of
- -- qualified names when needed, and when compiling for formal verification,
- -- in which the back-end calls directly Qualify_All_Entity_Names after some
- -- preprocessing which uses the non-qualified names.
+ -- qualified names when needed.
- if VM_Target = No_VM and then not ALFA_Mode then
+ if VM_Target = No_VM then
Exp_Dbug.Qualify_All_Entity_Names;
end if;
long time. If the source info file exists but cannot be parsed successfully,
the Project Manager will attempt to recreate it. If the Project Manager fails
to create the source info file, a message is issued, but gnatmake does not
-fail.
+fail. @command{gnatmake} "trusts" the source info file. This means that
+if the source files have changed (addition, deletion, moving to a different
+source directory), then the source info file need to be deleted and recreated.
@ifclear vms
@item --create-map-file
with Prj.Pars;
with Prj.Tree; use Prj.Tree;
with Prj.Util; use Prj.Util;
+with Sdefault;
with Sinput.P;
with Snames; use Snames;
with Table;
Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
Prj.Env.Initialize_Default_Project_Path
- (Root_Environment.Project_Path, Target_Name => "");
+ (Root_Environment.Project_Path,
+ Target_Name => Sdefault.Target_Name.all);
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
Write_Str (" <Current_Directory>");
Write_Eol;
+ -- The code below reproduces Prj.Env.Initialize_Default_Project_Path,
+ -- shouldn't we reuse that instead???
+
declare
Project_Path : String_Access := Getenv (Gpr_Project_Path);
Last : Natural;
Add_Default_Dir : Boolean := True;
+ Prefix_Name_Len : Integer;
begin
-- If there is a project path, display each directory in the path
end loop;
-- If the sequence "/lib"/ was found, display the default
- -- director
y <prefix>/lib/gnat/.
+ -- director
ies <prefix>/<target>/lib/gnat and <prefix>/lib/gnat/.
if Name_Len >= 5 then
- Name_Buffer (Name_Len + 1 .. Name_Len + 4) := "gnat";
- Name_Buffer (Name_Len + 5) := Directory_Separator;
- Name_Len := Name_Len + 5;
+ Prefix_Name_Len := Name_Len - 4;
+
+ Name_Len := Prefix_Name_Len;
+
+ Name_Len := Prefix_Name_Len;
+ Add_Str_To_Name_Buffer (Sdefault.Target_Name.all);
+ Name_Len := Name_Len - 1;
+ Add_Str_To_Name_Buffer (Directory_Separator
+ & "lib" & Directory_Separator
+ & "gnat" & Directory_Separator);
+ Write_Str (" ");
+ Write_Line
+ (To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all);
+
+ Name_Len := Prefix_Name_Len;
+ Add_Str_To_Name_Buffer ("lib" & Directory_Separator
+ & "gnat" & Directory_Separator);
Write_Str (" ");
Write_Line
(To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all);
if XE.Ent /= Cur_Entity then
Cur_Entity_Name :=
- new String'(Exact_Source_Name (Sloc (XE.Ent)));
+ new String'(Unique_Name (XE.Ent));
end if;
ALFA_Xref_Table.Append (
with Prj.Pars;
with Prj.Tree; use Prj.Tree;
with Prj.Util;
+with Sdefault;
with SFN_Scan;
with Sinput.P;
with Snames; use Snames;
Prj.Tree.Initialize (Env, Gnatmake_Flags);
Prj.Env.Initialize_Default_Project_Path
- (Env.Project_Path, Target_Name => "");
+ (Env.Project_Path, Target_Name => Sdefault.Target_Name.all);
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);
External_Name_Exp_Casing_Config := External_Name_Exp_Casing;
External_Name_Imp_Casing_Config := External_Name_Imp_Casing;
Fast_Math_Config := Fast_Math;
- Init_Or_Norm_Scalars_Config := Init_Or_Norm_Scalars;
Initialize_Scalars_Config := Initialize_Scalars;
- Normalize_Scalars_Config := Normalize_Scalars;
Optimize_Alignment_Config := Optimize_Alignment;
Persistent_BSS_Mode_Config := Persistent_BSS_Mode;
Polling_Required_Config := Polling_Required;
External_Name_Exp_Casing := Save.External_Name_Exp_Casing;
External_Name_Imp_Casing := Save.External_Name_Imp_Casing;
Fast_Math := Save.Fast_Math;
- Init_Or_Norm_Scalars := Save.Init_Or_Norm_Scalars;
Initialize_Scalars := Save.Initialize_Scalars;
- Normalize_Scalars := Save.Normalize_Scalars;
Optimize_Alignment := Save.Optimize_Alignment;
Optimize_Alignment_Local := Save.Optimize_Alignment_Local;
Persistent_BSS_Mode := Save.Persistent_BSS_Mode;
Polling_Required := Save.Polling_Required;
Short_Descriptors := Save.Short_Descriptors;
Use_VADS_Size := Save.Use_VADS_Size;
+
+ -- Update consistently the value of Init_Or_Norm_Scalars. The value of
+ -- Normalize_Scalars is not saved/restored because after set to True its
+ -- value is never changed. That is, if a compilation unit has pragma
+ -- Normalize_Scalars then it forces that value for all with'ed units.
+
+ Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
end Restore_Opt_Config_Switches;
------------------------------
Save.External_Name_Exp_Casing := External_Name_Exp_Casing;
Save.External_Name_Imp_Casing := External_Name_Imp_Casing;
Save.Fast_Math := Fast_Math;
- Save.Init_Or_Norm_Scalars := Init_Or_Norm_Scalars;
Save.Initialize_Scalars := Initialize_Scalars;
- Save.Normalize_Scalars := Normalize_Scalars;
Save.Optimize_Alignment := Optimize_Alignment;
Save.Optimize_Alignment_Local := Optimize_Alignment_Local;
Save.Persistent_BSS_Mode := Persistent_BSS_Mode;
External_Name_Exp_Casing := External_Name_Exp_Casing_Config;
External_Name_Imp_Casing := External_Name_Imp_Casing_Config;
Fast_Math := Fast_Math_Config;
- Init_Or_Norm_Scalars := Init_Or_Norm_Scalars_Config;
Initialize_Scalars := Initialize_Scalars_Config;
- Normalize_Scalars := Normalize_Scalars_Config;
Optimize_Alignment := Optimize_Alignment_Config;
Optimize_Alignment_Local := False;
Persistent_BSS_Mode := Persistent_BSS_Mode_Config;
Use_VADS_Size := Use_VADS_Size_Config;
+
+ -- Update consistently the value of Init_Or_Norm_Scalars. The value
+ -- of Normalize_Scalars is not saved/restored because once set to
+ -- True its value is never changed. That is, if a compilation unit
+ -- has pragma Normalize_Scalars then it forces that value for all
+ -- with'ed units.
+
+ Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
end if;
Default_Pool := Default_Pool_Config;
-- used to set the initial value of Fast_Math at the start of each new
-- compilation unit.
- Init_Or_Norm_Scalars_Config : Boolean;
- -- GNAT
- -- This is the value of the configuration switch that is set by one
- -- of the pragmas Initialize_Scalars or Normalize_Scalars.
-
Initialize_Scalars_Config : Boolean;
-- GNAT
-- This is the value of the configuration switch that is set by the
-- This switch is not set when the pragma appears ahead of a given
-- unit, so it does not affect the compilation of other units.
- Normalize_Scalars_Config : Boolean;
- -- GNAT
- -- This is the value of the configuration switch that is set by the
- -- pragma Normalize_Scalars when it appears in the gnat.adc file.
- -- This switch is not set when the pragma appears ahead of a given
- -- unit, so it does not affect the compilation of other units.
-
Optimize_Alignment_Config : Character;
-- GNAT
-- This is the value of the configuration switch that controls the
External_Name_Exp_Casing : External_Casing_Type;
External_Name_Imp_Casing : External_Casing_Type;
Fast_Math : Boolean;
- Init_Or_Norm_Scalars : Boolean;
Initialize_Scalars : Boolean;
Normalize_Scalars : Boolean;
Optimize_Alignment : Character;
if Add_Default_Dir then
declare
- Prefix : String_Ptr := Sdefault.Search_Dir_Prefix;
+ Prefix : String_Ptr;
+ Add_Prefix_Share_Gpr : Boolean;
begin
- if Prefix = null then
+ if Sdefault.Search_Dir_Prefix = null then
+
+ -- gprbuild case
+
Prefix := new String'(Executable_Prefix_Path);
+ Add_Prefix_Share_Gpr := True;
- if Prefix.all /= "" then
- if Target_Name /= "" then
- Add_Str_To_Name_Buffer
- (Path_Separator & Prefix.all &
- Target_Name & Directory_Separator &
- "lib" & Directory_Separator & "gnat");
- end if;
+ else
+ Prefix := new String'(Sdefault.Search_Dir_Prefix.all
+ & ".." & Dir_Separator
+ & ".." & Dir_Separator
+ & ".." & Dir_Separator
+ & ".." & Dir_Separator);
+ Add_Prefix_Share_Gpr := False;
+ end if;
+
+ if Prefix.all /= "" then
+ if Target_Name /= "" then
+
+ -- $prefix/$target/lib/gnat
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
- "share" & Directory_Separator & "gpr");
+ Target_Name);
+
+ -- Note: Target_Name has a trailing / when it comes from
+ -- Sdefault.
+
+ if Name_Buffer (Name_Len) /= '/' then
+ Add_Char_To_Name_Buffer (Directory_Separator);
+ end if;
+
+ Add_Str_To_Name_Buffer
+ ("lib" & Directory_Separator & "gnat");
+ end if;
+
+ if Add_Prefix_Share_Gpr then
+
+ -- $prefix/share/gpr
+
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
- "lib" & Directory_Separator & "gnat");
+ "share" & Directory_Separator & "gpr");
end if;
- else
- Self.Path :=
- new String'(Name_Buffer (1 .. Name_Len) & Path_Separator &
- Prefix.all &
- ".." & Directory_Separator &
- ".." & Directory_Separator &
- ".." & Directory_Separator & "gnat");
+ -- $prefix/lib/gnat
+
+ Add_Str_To_Name_Buffer
+ (Path_Separator & Prefix.all &
+ "lib" & Directory_Separator & "gnat");
end if;
Free (Prefix);
end;
end if;
- if Self.Path = null then
- Self.Path := new String'(Name_Buffer (1 .. Name_Len));
- end if;
+ Self.Path := new String'(Name_Buffer (1 .. Name_Len));
end Initialize_Default_Project_Path;
--------------
with Prj.PP;
with Prj.Tree; use Prj.Tree;
with Prj.Util; use Prj.Util;
+with Sdefault;
with Snames; use Snames;
with Table; use Table;
Prj.Tree.Initialize (Root_Environment, Flags);
Prj.Env.Initialize_Default_Project_Path
- (Root_Environment.Project_Path, Target_Name => "");
+ (Root_Environment.Project_Path,
+ Target_Name => Sdefault.Target_Name.all);
Prj.Tree.Initialize (Tree);
-- Determine whether one of the candidates is an operation inherited by
-- a type that is derived from an actual in an instantiation.
+ function In_Same_Declaration_List
+ (Typ : Entity_Id;
+ Op_Decl : Entity_Id) return Boolean;
+ -- AI05-0020: a spurious ambiguity may arise when equality on anonymous
+ -- access types is declared on the partial view of a designated type, so
+ -- that the type declaration and equality are not in the same list of
+ -- declarations. This AI gives a preference rule for the user-defined
+ -- operation. Same rule applies for arithmetic operations on private
+ -- types completed with fixed-point types: the predefined operation is
+ -- hidden; this is already handled properly in GNAT.
+
function Is_Actual_Subprogram (S : Entity_Id) return Boolean;
-- Determine whether a subprogram is an actual in an enclosing instance.
-- An overloading between such a subprogram and one declared outside the
end if;
end Inherited_From_Actual;
+ ------------------------------
+ -- In_Same_Declaration_List --
+ ------------------------------
+
+ function In_Same_Declaration_List
+ (Typ : Entity_Id;
+ Op_Decl : Entity_Id) return Boolean
+ is
+ Scop : constant Entity_Id := Scope (Typ);
+
+ begin
+ return In_Same_List (Parent (Typ), Op_Decl)
+ or else
+ (Ekind_In (Scop, E_Package, E_Generic_Package)
+ and then List_Containing (Op_Decl) =
+ Visible_Declarations (Parent (Scop))
+ and then List_Containing (Parent (Typ)) =
+ Private_Declarations (Parent (Scop)));
+ end In_Same_Declaration_List;
+
--------------------------
-- Is_Actual_Subprogram --
--------------------------
and then Etype (User_Subp) = Standard_Boolean
and then Ekind (Operand_Type) = E_Anonymous_Access_Type
and then
- In_Same_List (Parent (Designated_Type (Operand_Type)),
- Unit_Declaration_Node (User_Subp))
+ In_Same_Declaration_List
+ (Designated_Type (Operand_Type),
+ Unit_Declaration_Node (User_Subp))
then
if It2.Nam = Predef_Subp then
return It1;
end case;
end Unique_Defining_Entity;
+ -----------------
+ -- Unique_Name --
+ -----------------
+
+ function Unique_Name (E : Entity_Id) return String is
+ Name : constant String := Get_Name_String (Chars (E));
+ begin
+ if Has_Fully_Qualified_Name (E)
+ or else E = Standard_Standard
+ then
+ return Name;
+ else
+ return Unique_Name (Scope (E)) & "__" & Name;
+ end if;
+ end Unique_Name;
+
--------------------------
-- Unit_Declaration_Node --
--------------------------
-- Return the entity which represents declaration N, so that matching
-- declaration and body have the same entity.
+ function Unique_Name (E : Entity_Id) return String;
+ -- Return a unique name for entity E, which could be used to identify E
+ -- across compilation units.
+
function Unit_Declaration_Node (Unit_Id : Entity_Id) return Node_Id;
-- Unit_Id is the simple name of a program unit, this function returns the
-- corresponding xxx_Declaration node for the entity. Also applies to the
projects / gcc.git / commitdiff