mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-05 10:50:51 +08:00
[multiple changes]
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. From-SVN: r164978
This commit is contained in:
Arnaud Charlet
parent
610ef7c0f9
commit
96d2756f41
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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:
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 =>
|
||||
|
||||
@ -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 --
|
||||
-----------------------
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -632,9 +632,24 @@ Several attributes can be used to specify the switches:
|
||||
@b{end} Compiler;
|
||||
@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}
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user