aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2010-10-05 12:07:35 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2010-10-05 12:07:35 +0200
commit96d2756f41a4a5f90fa8c302e38be5e35761d14b (patch)
tree0fa2829f8d8a8f4fb45ed1d55d449fa99eaed70b /gcc/ada
parent610ef7c0f9b816601f89d3483ef9824da717c0e3 (diff)
downloadgcc-96d2756f41a4a5f90fa8c302e38be5e35761d14b.zip
gcc-96d2756f41a4a5f90fa8c302e38be5e35761d14b.tar.gz
gcc-96d2756f41a4a5f90fa8c302e38be5e35761d14b.tar.bz2
[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
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog29
-rw-r--r--gcc/ada/a-direct.adb13
-rw-r--r--gcc/ada/a-direct.ads18
-rw-r--r--gcc/ada/back_end.adb2
-rw-r--r--gcc/ada/checks.adb2
-rw-r--r--gcc/ada/debug.adb6
-rw-r--r--gcc/ada/einfo.adb2
-rw-r--r--gcc/ada/exp_attr.adb32
-rw-r--r--gcc/ada/make.adb18
-rw-r--r--gcc/ada/prj-util.adb19
-rw-r--r--gcc/ada/prj-util.ads6
-rw-r--r--gcc/ada/projects.texi15
-rw-r--r--gcc/ada/sem_res.adb13
13 files changed, 129 insertions, 46 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b956feb..1ace8e1 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 c2c19d9..e4a2697 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 ddabed6..267c9c2 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 697ad48..7172696 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 e73f644..2362c13 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 ba2845d..c6fa834 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 ef0efdf..0793a60 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 ab48159..7af8cab 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 da2707b..154e1dd 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 ce5c38f..1bc8b11 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 b34769e..5ee0ee7 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 849ca40..67eb907 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 2190b59..b377bf2 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