diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 29 | ||||
| -rw-r--r-- | gcc/ada/a-direct.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/a-direct.ads | 18 | ||||
| -rw-r--r-- | gcc/ada/back_end.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/checks.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/debug.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/einfo.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/exp_attr.adb | 32 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/prj-util.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/prj-util.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/projects.texi | 15 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 13 |
13 files changed, 129 insertions, 46 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b956febd489..1ace8e1e382 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2010-10-05 Ed Schonberg <schonberg@adacore.com> + + * sem_res.adb (Check_Parameterless_Call): If the prefix of 'Address is + an explicit dereference of an access to function, the prefix is not + interpreted as a parameterless call. + +2010-10-05 Ed Schonberg <schonberg@adacore.com> + + * exp_attr.adb: For 'Read and 'Write, use full view of base type if + private. + +2010-10-05 Vincent Celier <celier@adacore.com> + + * make.adb (Switches_Of): Allow wild cards in index of attributes + Switches. + * prj-util.adb (Value_Of): When Allow_Wildcards is True, use the index + of the associative array as a glob regular expression. + * prj-util.ads (Value_Of (Index, In_Array)): New Boolean parameter + Allow_Wildcards, defaulted to False. + (Value_Of (Name, Attribute_Or_Array_Name)): Ditto + * projects.texi: Document that attribute Switches (<file name>) may + use wild cards in the index. + +2010-10-05 Robert Dewar <dewar@adacore.com> + + * a-direct.adb, a-direct.ads, back_end.adb, checks.adb, + einfo.adb: Minor reformatting. + * debug.adb: Remove obsolete documentation for d.Z flag. + 2010-10-05 Vincent Celier <celier@adacore.com> * vms_data.ads: Add VMS qualifier /SRC_INFO= corresponding to gnatmake diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb index c2c19d9142e..e4a2697e063 100644 --- a/gcc/ada/a-direct.adb +++ b/gcc/ada/a-direct.adb @@ -39,11 +39,10 @@ with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; with Ada.Characters.Handling; use Ada.Characters.Handling; -with System.CRTL; use System.CRTL; -with System.OS_Lib; use System.OS_Lib; -with System.Regexp; use System.Regexp; -with System.File_IO; use System.File_IO; - +with System.CRTL; use System.CRTL; +with System.OS_Lib; use System.OS_Lib; +with System.Regexp; use System.Regexp; +with System.File_IO; use System.File_IO; with System; package body Ada.Directories is @@ -302,8 +301,7 @@ package body Ada.Directories is Target_Name : String; Form : String := "") is - Success : Boolean; - + Success : Boolean; Mode : Copy_Mode := Overwrite; Preserve : Attribute := None; @@ -331,7 +329,6 @@ package body Ada.Directories is V1, V2 : Natural; begin - -- Acquire form string, setting required NUL terminator Formstr (1 .. Form'Length) := Form; diff --git a/gcc/ada/a-direct.ads b/gcc/ada/a-direct.ads index ddabed6fc33..267c9c2e233 100644 --- a/gcc/ada/a-direct.ads +++ b/gcc/ada/a-direct.ads @@ -105,7 +105,7 @@ package Ada.Directories is -- the external environment does not support the creation of a directory -- with the given name (in the absence of Name_Error) and form. -- - -- The Form parameter is ignored. + -- The Form parameter is ignored procedure Delete_Directory (Directory : String); -- Deletes an existing empty directory with name Directory. The exception @@ -132,7 +132,7 @@ package Ada.Directories is -- not support the creation of any directories with the given name (in the -- absence of Name_Error) and form. -- - -- The Form parameter is ignored. + -- The Form parameter is ignored procedure Delete_Tree (Directory : String); -- Deletes an existing directory with name Directory. The directory and @@ -164,17 +164,17 @@ package Ada.Directories is (Source_Name : String; Target_Name : String; Form : String := ""); - -- Copies the contents of the existing external file with Source_Name - -- to Target_Name. The resulting external file is a duplicate of the source - -- external file. The Form can be used to give system-dependent + -- Copies the contents of the existing external file with Source_Name to + -- Target_Name. The resulting external file is a duplicate of the source + -- external file. The Form argument can be used to give system-dependent -- characteristics of the resulting external file; the interpretation of -- the Form parameter is implementation-defined. Exception Name_Error is -- propagated if the string given as Source_Name does not identify an -- existing external ordinary or special file or if the string given as - -- Target_Name does not allow the identification of an external file. - -- The exception Use_Error is propagated if the external environment does - -- not support the creating of the file with the name given by Target_Name - -- and form given by Form, or copying of the file with the name given by + -- Target_Name does not allow the identification of an external file. The + -- exception Use_Error is propagated if the external environment does not + -- support the creating of the file with the name given by Target_Name and + -- form given by Form, or copying of the file with the name given by -- Source_Name (in the absence of Name_Error). -- -- Interpretation of the Form parameter: diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb index 697ad484d2a..7172696b5e1 100644 --- a/gcc/ada/back_end.adb +++ b/gcc/ada/back_end.adb @@ -124,7 +124,7 @@ package body Back_End is if CodePeer_Mode or else (Mode /= Generate_Object - and then not Back_Annotate_Rep_Info) + and then not Back_Annotate_Rep_Info) then return; end if; diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index e73f644025b..2362c13acb4 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -4104,7 +4104,7 @@ package body Checks is -- with them will be valid as well. if Base_Type (Typ) = Standard_Boolean - and then + and then (Nkind (Expr) in N_Op or else Nkind (Expr) in N_Short_Circuit) then return; diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index ba2845ddbfa..c6fa834401f 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -596,12 +596,6 @@ package body Debug is -- case of the gcc back end. Provided as a back up in case the new -- scheme has problems. - -- d.Z This flag enables the frontend call-graph output associated with - -- dispatching calls. This is a temporary debug flag to be used during - -- development of this output. Once it works, it will always be output - -- (as part of the standard call-graph output) by default, and this - -- flag will be removed. - -- d1 Error messages have node numbers where possible. Normally error -- messages have only source locations. This option is useful when -- debugging errors caused by expanded code, where the source location diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index ef0efdf72a5..0793a6071e2 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -7703,7 +7703,7 @@ package body Einfo is Write_Str ("Renamed_Entity"); when Incomplete_Or_Private_Kind | - E_Record_Subtype => + E_Record_Subtype => Write_Str ("Private_Dependents"); when Concurrent_Kind => diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index ab48159b2ac..7af8cabd7a7 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -155,6 +155,11 @@ package body Exp_Attr is -- defining it, is returned. In both cases, inheritance of representation -- aspects is thus taken into account. + function Full_Base (T : Entity_Id) return Entity_Id; + -- The stream functions need to examine the underlying representation of + -- composite types. In some cases T may be non-private but its base type + -- is, in which case the function returns the corresponding full view. + function Get_Stream_Convert_Pragma (T : Entity_Id) return Node_Id; -- Given a type, find a corresponding stream convert pragma that applies to -- the implementation base type of this type (Typ). If found, return the @@ -3770,10 +3775,10 @@ package body Exp_Attr is (Discriminant_Default_Value (First_Discriminant (U_Type))) then Build_Mutable_Record_Read_Procedure - (Loc, Base_Type (U_Type), Decl, Pname); + (Loc, Full_Base (U_Type), Decl, Pname); else Build_Record_Read_Procedure - (Loc, Base_Type (U_Type), Decl, Pname); + (Loc, Full_Base (U_Type), Decl, Pname); end if; -- Suppress checks, uninitialized or otherwise invalid @@ -5245,10 +5250,10 @@ package body Exp_Attr is (Discriminant_Default_Value (First_Discriminant (U_Type))) then Build_Mutable_Record_Write_Procedure - (Loc, Base_Type (U_Type), Decl, Pname); + (Loc, Full_Base (U_Type), Decl, Pname); else Build_Record_Write_Procedure - (Loc, Base_Type (U_Type), Decl, Pname); + (Loc, Full_Base (U_Type), Decl, Pname); end if; Insert_Action (N, Decl); @@ -5638,6 +5643,25 @@ package body Exp_Attr is end if; end Find_Stream_Subprogram; + --------------- + -- Full_Base -- + --------------- + + function Full_Base (T : Entity_Id) return Entity_Id is + BT : Entity_Id; + + begin + BT := Base_Type (T); + + if Is_Private_Type (BT) + and then Present (Full_View (BT)) + then + BT := Full_View (BT); + end if; + + return BT; + end Full_Base; + ----------------------- -- Get_Index_Subtype -- ----------------------- diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index da2707b36e2..154e1dd2450 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -8361,10 +8361,11 @@ package body Make is Switches := Prj.Util.Value_Of - (Index => Name_Id (Source_File), - Src_Index => Source_Index, - In_Array => Switches_Array, - In_Tree => Project_Tree); + (Index => Name_Id (Source_File), + Src_Index => Source_Index, + In_Array => Switches_Array, + In_Tree => Project_Tree, + Allow_Wildcards => True); -- Check also without the suffix @@ -8406,10 +8407,11 @@ package body Make is Add_Str_To_Name_Buffer (Name (1 .. Last)); Switches := Prj.Util.Value_Of - (Index => Name_Find, - Src_Index => 0, - In_Array => Switches_Array, - In_Tree => Project_Tree); + (Index => Name_Find, + Src_Index => 0, + In_Array => Switches_Array, + In_Tree => Project_Tree, + Allow_Wildcards => True); if Switches = Nil_Variable_Value and then Allow_ALI then Last := Source_File_Name'Length; diff --git a/gcc/ada/prj-util.adb b/gcc/ada/prj-util.adb index ce5c38fefa2..1bc8b11bf07 100644 --- a/gcc/ada/prj-util.adb +++ b/gcc/ada/prj-util.adb @@ -26,6 +26,7 @@ with Ada.Unchecked_Deallocation; with GNAT.Case_Util; use GNAT.Case_Util; +with GNAT.Regexp; use GNAT.Regexp; with Osint; use Osint; with Output; use Output; @@ -848,7 +849,8 @@ package body Prj.Util is Src_Index : Int := 0; In_Array : Array_Element_Id; In_Tree : Project_Tree_Ref; - Force_Lower_Case_Index : Boolean := False) return Variable_Value + Force_Lower_Case_Index : Boolean := False; + Allow_Wildcards : Boolean := False) return Variable_Value is Current : Array_Element_Id; Element : Array_Element; @@ -888,8 +890,13 @@ package body Prj.Util is end if; end if; - if Real_Index_1 = Real_Index_2 and then - Src_Index = Element.Src_Index + if Src_Index = Element.Src_Index and then + (Real_Index_1 = Real_Index_2 or else + (Real_Index_2 /= All_Other_Names and then + Allow_Wildcards and then + Match (Get_Name_String (Real_Index_1), + Compile (Get_Name_String (Real_Index_2), + Glob => True)))) then return Element.Value; else @@ -906,7 +913,8 @@ package body Prj.Util is Attribute_Or_Array_Name : Name_Id; In_Package : Package_Id; In_Tree : Project_Tree_Ref; - Force_Lower_Case_Index : Boolean := False) return Variable_Value + Force_Lower_Case_Index : Boolean := False; + Allow_Wildcards : Boolean := False) return Variable_Value is The_Array : Array_Element_Id; The_Attribute : Variable_Value := Nil_Variable_Value; @@ -927,7 +935,8 @@ package body Prj.Util is Src_Index => Index, In_Array => The_Array, In_Tree => In_Tree, - Force_Lower_Case_Index => Force_Lower_Case_Index); + Force_Lower_Case_Index => Force_Lower_Case_Index, + Allow_Wildcards => Allow_Wildcards); -- If there is no array element, look for a variable diff --git a/gcc/ada/prj-util.ads b/gcc/ada/prj-util.ads index b34769e75f1..5ee0ee78b42 100644 --- a/gcc/ada/prj-util.ads +++ b/gcc/ada/prj-util.ads @@ -86,7 +86,8 @@ package Prj.Util is Src_Index : Int := 0; In_Array : Array_Element_Id; In_Tree : Project_Tree_Ref; - Force_Lower_Case_Index : Boolean := False) return Variable_Value; + Force_Lower_Case_Index : Boolean := False; + Allow_Wildcards : Boolean := False) return Variable_Value; -- Get a string array component (single String or String list). Returns -- Nil_Variable_Value if no component Index or if In_Array is null. -- @@ -101,7 +102,8 @@ package Prj.Util is Attribute_Or_Array_Name : Name_Id; In_Package : Package_Id; In_Tree : Project_Tree_Ref; - Force_Lower_Case_Index : Boolean := False) return Variable_Value; + Force_Lower_Case_Index : Boolean := False; + Allow_Wildcards : Boolean := False) return Variable_Value; -- In a specific package, -- - if there exists an array Attribute_Or_Array_Name with an index Name, -- returns the corresponding component (depending on the attribute, the diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index 849ca40fb79..67eb907f4f7 100644 --- a/gcc/ada/projects.texi +++ b/gcc/ada/projects.texi @@ -633,8 +633,23 @@ Several attributes can be used to specify the switches: @end smallexample @noindent + @code{Switches} may take a pattern as an index, such as in: + + @smallexample + @b{package} Compiler @b{is} + @b{for} Default_Switches ("Ada") @b{use} ("-O2"); + @b{for} Switches ("pkg*") @b{use} ("-O0"); + @b{end} Compiler; + @end smallexample + + @noindent + Sources @file{pkg.adb} and @file{pkg-child.adb} would be compiled with -O0, + not -O2. + + @noindent @code{Switches} can also be given a language name as index instead of a file name in which case it has the same semantics as @emph{Default_Switches}. + However, indexes with wild cards are never valid for language name. @item @b{Local_Configuration_Pragmas}: @cindex @code{Local_Configuration_Pragmas} diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 2190b59bc46..b377bf28b38 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -1011,6 +1011,17 @@ package body Sem_Res is It : Interp; begin + -- if the context is an attribute reference that can apply to + -- functions, this is never a parameterless call. (RM 4.1.4 (6)) + + if Nkind (Parent (N)) = N_Attribute_Reference + and then (Attribute_Name (Parent (N)) = Name_Address + or else Attribute_Name (Parent (N)) = Name_Code_Address + or else Attribute_Name (Parent (N)) = Name_Access) + then + return False; + end if; + if not Is_Overloaded (N) then return Ekind (Etype (N)) = E_Subprogram_Type @@ -1070,7 +1081,7 @@ package body Sem_Res is -- If the entity is the name of an operator, it cannot be a call because -- operators cannot have default parameters. In this case, this must be -- a string whose contents coincide with an operator name. Set the kind - -- of the node appropriately and reanalyze. + -- of the node appropriately. if (Is_Entity_Name (N) and then Nkind (N) /= N_Operator_Symbol |