* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164978
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
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
Target_Name : String;
Form : String := "")
is
- Success : Boolean;
-
+ Success : Boolean;
Mode : Copy_Mode := Overwrite;
Preserve : Attribute := None;
V1, V2 : Natural;
begin
-
-- Acquire form string, setting required NUL terminator
Formstr (1 .. Form'Length) := Form;
-- 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
-- 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
(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:
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;
-- 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;
-- 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
Write_Str ("Renamed_Entity");
when Incomplete_Or_Private_Kind |
- E_Record_Subtype =>
+ E_Record_Subtype =>
Write_Str ("Private_Dependents");
when Concurrent_Kind =>
-- 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
(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
(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);
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 --
-----------------------
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
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;
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;
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;
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
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;
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
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.
--
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
@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}
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
-- 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
projects / platform / upstream / linaro-gcc.git / commitdiff