From 23c4ff9bd4ea80f3c034f1a2c4318073513bed9f Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 13 Jul 2009 11:35:45 +0200 Subject: [PATCH] [multiple changes] 2009-07-13 Emmanuel Briot * prj-env.adb (Create_Config_Pragmas_File): Iterate on sources rather than units. 2009-07-13 Thomas Quinot * 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 * exp_dbug.ads: Add documentation note on the utility of DW_AT_GNAT_encoding for IDEs. 2009-07-13 Robert Dewar * g-socthi-vxworks.adb: Minor reformatting * gnatcmd.adb: Minor reformatting From-SVN: r149561 --- gcc/ada/ChangeLog | 23 ++++++++++++++ gcc/ada/exp_dbug.ads | 53 +++++++++++++++++--------------- gcc/ada/g-socthi-vxworks.adb | 3 ++ gcc/ada/gnatcmd.adb | 8 ++--- gcc/ada/prj-env.adb | 58 +++++++++++++----------------------- gcc/ada/sem_ch3.adb | 18 ++++++++++- gcc/ada/sem_type.adb | 25 +++++++--------- gcc/ada/sem_type.ads | 17 ++++------- 8 files changed, 111 insertions(+), 94 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0e8ea163800..026acffaffe 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2009-07-13 Emmanuel Briot + + * prj-env.adb (Create_Config_Pragmas_File): Iterate on sources rather + than units. + +2009-07-13 Thomas Quinot + + * 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 + + * exp_dbug.ads: Add documentation note on the utility of + DW_AT_GNAT_encoding for IDEs. + +2009-07-13 Robert Dewar + + * g-socthi-vxworks.adb: Minor reformatting + + * gnatcmd.adb: Minor reformatting + 2009-07-13 Thomas Quinot * rtsfind.ads, exp_dist.adb (RE_Allocate_Buffer): Runtime entry diff --git a/gcc/ada/exp_dbug.ads b/gcc/ada/exp_dbug.ads index 3a6297ce9ee..15e83aaf113 100644 --- a/gcc/ada/exp_dbug.ads +++ b/gcc/ada/exp_dbug.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -1522,33 +1522,38 @@ package Exp_Dbug is -- 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; diff --git a/gcc/ada/g-socthi-vxworks.adb b/gcc/ada/g-socthi-vxworks.adb index 8a90056312b..96d0cfca7a3 100644 --- a/gcc/ada/g-socthi-vxworks.adb +++ b/gcc/ada/g-socthi-vxworks.adb @@ -369,12 +369,15 @@ package body GNAT.Sockets.Thin is 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; diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index ef1cf3e712d..8349d439318 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -364,7 +364,7 @@ procedure GNATCmd is 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 @@ -390,7 +390,7 @@ procedure GNATCmd is 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"); @@ -1080,9 +1080,7 @@ procedure GNATCmd is -- 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 diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index e3766b5d70e..55f025d8359 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -401,9 +401,9 @@ package body Prj.Env is 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 @@ -418,11 +418,7 @@ package body Prj.Env is -- 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); @@ -449,7 +445,7 @@ package body Prj.Env is 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; @@ -559,12 +555,7 @@ package body Prj.Env is -- 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 @@ -573,20 +564,20 @@ package body Prj.Env is -- 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, ");"); @@ -652,30 +643,21 @@ package body Prj.Env is 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 diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index c6a10e01b86..9c289e75136 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -7905,7 +7905,7 @@ package body Sem_Ch3 is -- 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 @@ -16443,6 +16443,22 @@ package body Sem_Ch3 is 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; ----------------------------------- diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 5883e3fe867..fad78d49d9b 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -1204,9 +1204,9 @@ package body Sem_Type is -- 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); @@ -2147,9 +2147,8 @@ package body Sem_Type is ------------------------- 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; @@ -2597,9 +2596,8 @@ package body Sem_Type is --------------------------- 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); @@ -2809,9 +2807,8 @@ package body Sem_Type is 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) @@ -2892,7 +2889,7 @@ package body Sem_Type is 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 @@ -2903,7 +2900,7 @@ package body Sem_Type is 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; diff --git a/gcc/ada/sem_type.ads b/gcc/ada/sem_type.ads index 879432435fd..cfbc579bf08 100644 --- a/gcc/ada/sem_type.ads +++ b/gcc/ada/sem_type.ads @@ -103,10 +103,7 @@ package Sem_Type is -- 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. @@ -172,8 +169,7 @@ package Sem_Type is 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 @@ -191,10 +187,7 @@ package Sem_Type is -- 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 @@ -220,11 +213,11 @@ package Sem_Type is 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 -- 2.30.2