+2009-07-13 Emmanuel Briot <briot@adacore.com>
+
+ * prj-env.adb (Create_Config_Pragmas_File): Iterate on sources rather
+ than units.
+
+2009-07-13 Thomas Quinot <quinot@adacore.com>
+
+ * sem_ch3.adb (Process_Full_View): Propagate Has_Specified_Stream_{Read,
+ Write,Input,Output} from private view to full view.
+
+ * sem_type.adb, sem_type.ads: Minor reformatting
+
+2009-07-13 Nicolas Setton <setton@adacore.com>
+
+ * exp_dbug.ads: Add documentation note on the utility of
+ DW_AT_GNAT_encoding for IDEs.
+
+2009-07-13 Robert Dewar <dewar@adacore.com>
+
+ * g-socthi-vxworks.adb: Minor reformatting
+
+ * gnatcmd.adb: Minor reformatting
+
2009-07-13 Thomas Quinot <quinot@adacore.com>
* rtsfind.ads, exp_dist.adb (RE_Allocate_Buffer): Runtime entry
-- --
-- S p e c --
-- --
--- Copyright (C) 1996-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2009, 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- --
-- to DWARF2/3 are generated, with the following variations from the above
-- specification.
- -- Change in the contents of the DW_AT_name attribute.
- -- The operators are represented in their natural form. (Ie, the addition
- -- operator is written as "+" instead of "Oadd").
- -- The component separation string is "." instead of "__"
+ -- Change in the contents of the DW_AT_name attribute
- -- Introduction of DW_AT_GNAT_encoding, encoded with value 0x2301.
- -- Any debugging information entry representing a program entity, named
- -- or implicit, may have a DW_AT_GNAT_encoding attribute. The value of
- -- this attribute is a string representing the suffix internally added
- -- by GNAT for various purposes, mainly for representing debug
- -- information compatible with other formats.
+ -- The operators are represented in their natural form. (for example,
+ -- the addition operator is written as "+" instead of "Oadd"). The
+ -- component separator is "." instead of "__"
- -- If a debugging information entry has multiple encodings, all of them
- -- will be listed in DW_AT_GNAT_encoding. The separator for this list
- -- is ':'.
+ -- Introduction of DW_AT_GNAT_encoding, encoded with value 0x2301
+
+ -- Any debugging information entry representing a program entity, named
+ -- or implicit, may have a DW_AT_GNAT_encoding attribute. The value of
+ -- this attribute is a string representing the suffix internally added
+ -- by GNAT for various purposes, mainly for representing debug
+ -- information compatible with other formats. In particular this is
+ -- useful for IDEs which need to filter out information internal to
+ -- GNAT from their graphical interfaces.
+
+ -- If a debugging information entry has multiple encodings, all of them
+ -- will be listed in DW_AT_GNAT_encoding using the list separator ':'.
-- Introduction of DW_AT_GNAT_descriptive_type, encoded with value 0x2302
- -- Any debugging information entry representing a type may have a
- -- DW_AT_GNAT_descriptive_type attribute whose value is a reference,
- -- pointing to a debugging information entry representing another type
- -- associated to the type.
-
- -- Modification of the contents of the DW_AT_producer string.
- -- When emitting full GNAT Vendor extensions to DWARF2/3, "-gdwarf+"
- -- is appended to the DW_AT_producer string.
+
+ -- Any debugging information entry representing a type may have a
+ -- DW_AT_GNAT_descriptive_type attribute whose value is a reference,
+ -- pointing to a debugging information entry representing another type
+ -- associated to the type.
+
+ -- Modification of the contents of the DW_AT_producer string
+
+ -- When emitting full GNAT Vendor extensions to DWARF2/3, "-gdwarf+"
+ -- is appended to the DW_AT_producer string.
--
- -- When emitting only DW_AT_GNAT_descriptive_type, "-gdwarf+-" is
- -- appended to the DW_AT_producer string.
+ -- When emitting only DW_AT_GNAT_descriptive_type, "-gdwarf+-" is
+ -- appended to the DW_AT_producer string.
end Exp_Dbug;
begin
loop
if To = Null_Address then
+
-- In violation of the standard sockets API, VxWorks does not
-- support sendto(2) calls on connected sockets with a null
-- destination address, so use send(2) instead in that case.
Res := Syscall_Send (S, Msg, Len, Flags);
+ -- Normal case where destination address is non-null
+
else
Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
end if;
File :=
new String'
(Get_Name_String
- (Proj.Project.Object_Directory.Name) &
+ (Proj.Project.Object_Directory.Name) &
B_Start.all &
MLib.Fil.Ext_To
(Get_Name_String
File :=
new String'
(Get_Name_String
- (Proj.Project.Object_Directory.Name) &
+ (Proj.Project.Object_Directory.Name) &
B_Start.all &
Get_Name_String (Proj.Project.Library_Name) &
".ci");
-- replace the file with the absolute path.
Last_Switches.Table (J) :=
- new String'
- (Dir
- & ALI_File (1 .. Last));
+ new String'(Dir & ALI_File (1 .. Last));
-- And we are done
File_Name : Path_Name_Type := No_Path;
File : File_Descriptor := Invalid_FD;
- Current_Unit : Unit_Index := Units_Htable.Get_First (In_Tree.Units_HT);
-
Current_Naming : Naming_Id;
+ Iter : Source_Iterator;
+ Source : Source_Id;
Status : Boolean;
-- For call to Close
-- If not, create one, and put its name in the project data,
-- with the indication that it is a temporary file.
- procedure Put
- (Unit_Name : Name_Id;
- File_Name : File_Name_Type;
- Unit_Kind : Spec_Or_Body;
- Index : Int);
+ procedure Put (Source : Source_Id);
-- Put an SFN pragma in the temporary file
procedure Put (File : File_Descriptor; S : String);
if Lang = null then
if Current_Verbosity = High then
- Write_Str ("Languages does not contain Ada, nothing to do");
+ Write_Line (" Languages does not contain Ada, nothing to do");
end if;
return;
-- Put --
---------
- procedure Put
- (Unit_Name : Name_Id;
- File_Name : File_Name_Type;
- Unit_Kind : Spec_Or_Body;
- Index : Int)
- is
+ procedure Put (Source : Source_Id) is
begin
-- A temporary file needs to be open
-- Put the pragma SFN for the unit kind (spec or body)
Put (File, "pragma Source_File_Name_Project (");
- Put (File, Namet.Get_Name_String (Unit_Name));
+ Put (File, Namet.Get_Name_String (Source.Unit.Name));
- if Unit_Kind = Spec then
+ if Source.Kind = Spec then
Put (File, ", Spec_File_Name => """);
else
Put (File, ", Body_File_Name => """);
end if;
- Put (File, Namet.Get_Name_String (File_Name));
+ Put (File, Namet.Get_Name_String (Source.File));
Put (File, """");
- if Index /= 0 then
+ if Source.Index /= 0 then
Put (File, ", Index =>");
- Put (File, Index'Img);
+ Put (File, Source.Index'Img);
end if;
Put_Line (File, ");");
Check_Imported_Projects (For_Project, Dummy, Imported_First => False);
- -- Visit all the units and process those that need an SFN pragma
+ -- Visit all the files and process those that need an SFN pragma
- while Current_Unit /= No_Unit_Index loop
- if Current_Unit.File_Names (Spec) /= null
- and then Current_Unit.File_Names (Spec).Naming_Exception
- and then not Current_Unit.File_Names (Spec).Locally_Removed
- then
- Put (Current_Unit.Name,
- Current_Unit.File_Names (Spec).File,
- Spec,
- Current_Unit.File_Names (Spec).Index);
- end if;
+ Iter := For_Each_Source (In_Tree, For_Project);
- if Current_Unit.File_Names (Impl) /= null
- and then Current_Unit.File_Names (Impl).Naming_Exception
- and then not Current_Unit.File_Names (Impl).Locally_Removed
+ while Element (Iter) /= No_Source loop
+ Source := Element (Iter);
+
+ if Source.Index >= 1
+ and then not Source.Locally_Removed
+ and then Source.Unit /= null
then
- Put (Current_Unit.Name,
- Current_Unit.File_Names (Impl).File,
- Impl,
- Current_Unit.File_Names (Impl).Index);
+ Put (Source);
end if;
- Current_Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
+ Next (Iter);
end loop;
-- If there are no non standard naming scheme, issue the GNAT
-- declaration, all clauses are inherited.
if No (First_Rep_Item (Def_Id)) then
- Set_First_Rep_Item (Def_Id, First_Rep_Item (T));
+ Set_First_Rep_Item (Def_Id, First_Rep_Item (T));
end if;
if Is_Tagged_Type (T) then
Set_Is_CPP_Class (Full_T);
Set_Convention (Full_T, Convention_CPP);
end if;
+
+ -- If the private view has user specified stream attributes, then so has
+ -- the full view.
+
+ if Has_Specified_Stream_Read (Priv_T) then
+ Set_Has_Specified_Stream_Read (Full_T);
+ end if;
+ if Has_Specified_Stream_Write (Priv_T) then
+ Set_Has_Specified_Stream_Write (Full_T);
+ end if;
+ if Has_Specified_Stream_Input (Priv_T) then
+ Set_Has_Specified_Stream_Input (Full_T);
+ end if;
+ if Has_Specified_Stream_Output (Priv_T) then
+ Set_Has_Specified_Stream_Output (Full_T);
+ end if;
end Process_Full_View;
-----------------------------------
-- for special handling of expressions with universal operands, see
-- comments to Has_Abstract_Interpretation below.
- ------------------------
- -- In_Generic_Actual --
- ------------------------
+ -----------------------
+ -- In_Generic_Actual --
+ -----------------------
function In_Generic_Actual (Exp : Node_Id) return Boolean is
Par : constant Node_Id := Parent (Exp);
-------------------------
function Has_Compatible_Type
- (N : Node_Id;
- Typ : Entity_Id)
- return Boolean
+ (N : Node_Id;
+ Typ : Entity_Id) return Boolean
is
I : Interp_Index;
It : Interp;
---------------------------
function Is_Invisible_Operator
- (N : Node_Id;
- T : Entity_Id)
- return Boolean
+ (N : Node_Id;
+ T : Entity_Id) return Boolean
is
Orig_Node : constant Node_Id := Original_Node (N);
and then Base_Type (T1) = Base_Type (T)
and then Is_Numeric_Type (T);
- -- for division and multiplication, a user-defined function does
- -- not match the predefined universal_fixed operation, except in
- -- Ada83 mode.
+ -- For division and multiplication, a user-defined function does not
+ -- match the predefined universal_fixed operation, except in Ada 83.
elsif Op_Name = Name_Op_Divide then
return (Base_Type (T1) = Base_Type (T2)
II : Interp_Index;
begin
- -- Find end of Interp list and copy downward to erase the discarded one
+ -- Find end of interp list and copy downward to erase the discarded one
II := I + 1;
while Present (All_Interp.Table (II).Typ) loop
All_Interp.Table (J - 1) := All_Interp.Table (J);
end loop;
- -- Back up interp. index to insure that iterator will pick up next
+ -- Back up interp index to insure that iterator will pick up next
-- available interpretation.
I := I - 1;
-- in N. If the name is an expanded name, the homonyms are only those that
-- belong to the same scope.
- function Is_Invisible_Operator
- (N : Node_Id;
- T : Entity_Id)
- return Boolean;
+ function Is_Invisible_Operator (N : Node_Id; T : Entity_Id) return Boolean;
-- Check whether a predefined operation with universal operands appears in
-- a context in which the operators of the expected type are not visible.
function Disambiguate
(N : Node_Id;
I1, I2 : Interp_Index;
- Typ : Entity_Id)
- return Interp;
+ Typ : Entity_Id) return Interp;
-- If more than one interpretation of a name in a call is legal, apply
-- preference rules (universal types first) and operator visibility in
-- order to remove ambiguity. I1 and I2 are the first two interpretations
-- right operand, which has one interpretation compatible with that of L.
-- Return the type intersection of the two.
- function Has_Compatible_Type
- (N : Node_Id;
- Typ : Entity_Id)
- return Boolean;
+ function Has_Compatible_Type (N : Node_Id; Typ : Entity_Id) return Boolean;
-- Verify that some interpretation of the node N has a type compatible with
-- Typ. If N is not overloaded, then its unique type must be compatible
-- with Typ. Otherwise iterate through the interpretations of N looking for
function Is_Ancestor (T1, T2 : Entity_Id) return Boolean;
-- T1 is a tagged type (not class-wide). Verify that it is one of the
- -- ancestors of type T2 (which may or not be class-wide)
+ -- ancestors of type T2 (which may or not be class-wide).
function Is_Subtype_Of (T1 : Entity_Id; T2 : Entity_Id) return Boolean;
-- Checks whether T1 is any subtype of T2 directly or indirectly. Applies
- -- only to scalar subtypes ???
+ -- only to scalar subtypes???
function Operator_Matches_Spec (Op, New_S : Entity_Id) return Boolean;
-- Used to resolve subprograms renaming operators, and calls to user
projects / gcc.git / commitdiff