From 3860d46902591cda6423d375dd44975dec8bc6ea Mon Sep 17 00:00:00 2001
From: Arnaud Charlet <charlet@gcc.gnu.org>
Date: Wed, 6 Feb 2013 11:05:12 +0100
Subject: [PATCH] [multiple changes]
2013-02-06 Robert Dewar <dewar@adacore.com>
* exp_prag.adb, sem_ch3.adb, exp_attr.adb, sem_prag.adb, sem_ch6.adb,
exp_intr.adb, exp_dist.adb, sem_ch13.adb: Internal clean up for
N_Pragma nodes.
2013-02-06 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Minor text updates for pragma Warning.
2013-02-06 Geert Bosch <bosch@adacore.com>
* s-multip.adb (Number_Of_CPUs): Short-circuit in case of
CPU'Last = 1.
2013-02-06 Vincent Celier <celier@adacore.com>
* clean.adb (Delete): On VMS use host notation to delete all files.
From-SVN: r195788
---
gcc/ada/ChangeLog | 19 ++++++++++
gcc/ada/clean.adb | 17 ++++++++-
gcc/ada/exp_attr.adb | 4 +-
gcc/ada/exp_dist.adb | 4 +-
gcc/ada/exp_intr.adb | 4 +-
gcc/ada/exp_prag.adb | 64 +++++++++++++++-----------------
gcc/ada/gnat_rm.texi | 15 +++++---
gcc/ada/s-multip.adb | 16 +++++---
gcc/ada/sem_ch13.adb | 88 +++++++++++++++++++++++++++++---------------
gcc/ada/sem_ch3.adb | 7 ++--
gcc/ada/sem_ch6.adb | 2 +-
gcc/ada/sem_prag.adb | 14 +++----
12 files changed, 157 insertions(+), 97 deletions(-)
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f8a0188dac2e..4ab64a9e9236 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,22 @@
+2013-02-06 Robert Dewar <dewar@adacore.com>
+
+ * exp_prag.adb, sem_ch3.adb, exp_attr.adb, sem_prag.adb, sem_ch6.adb,
+ exp_intr.adb, exp_dist.adb, sem_ch13.adb: Internal clean up for
+ N_Pragma nodes.
+
+2013-02-06 Robert Dewar <dewar@adacore.com>
+
+ * gnat_rm.texi: Minor text updates for pragma Warning.
+
+2013-02-06 Geert Bosch <bosch@adacore.com>
+
+ * s-multip.adb (Number_Of_CPUs): Short-circuit in case of
+ CPU'Last = 1.
+
+2013-02-06 Vincent Celier <celier@adacore.com>
+
+ * clean.adb (Delete): On VMS use host notation to delete all files.
+
2013-02-06 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, sem_ch6.adb, prj-conf.adb, erroutc.adb: Minor
diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb
index 560ceb7d33ee..e2d2446e500f 100644
--- a/gcc/ada/clean.adb
+++ b/gcc/ada/clean.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2003-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2003-2013, 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- --
@@ -1253,7 +1253,20 @@ package body Clean is
-- On VMS, we have to delete all versions of the file
if OpenVMS_On_Target then
- Delete_File (Full_Name (1 .. Last) & ";*", Success);
+ declare
+ Host_Full_Name : constant String_Access :=
+ To_Host_File_Spec (Full_Name (1 .. Last));
+ begin
+ if Host_Full_Name = null
+ or else Host_Full_Name'Length = 0
+ then
+ Success := False;
+
+ else
+ Delete_File
+ (Host_Full_Name.all & ";*", Success);
+ end if;
+ end;
-- Otherwise just delete the specified file
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 1147724c91e3..54442db72b4e 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
@@ -2120,7 +2120,7 @@ package body Exp_Attr is
Defining_Unit_Name => Ent)),
Make_Pragma (Loc,
- Chars => Name_Import,
+ Chars => Name_Import,
Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc, Expression => Lang),
diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index 8649fafff54f..e0e7250a3b76 100644
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
@@ -2176,7 +2176,7 @@ package body Exp_Dist is
Append_To (Decls,
Make_Pragma (Loc,
- Chars => Name_Import,
+ Chars => Name_Import,
Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
Chars => Name_Convention,
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index f86cbe5e2486..2d0d817fc8a1 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
@@ -454,7 +454,7 @@ package body Exp_Intr is
New_Occurrence_Of (Standard_Character, Loc)),
Make_Pragma (Loc,
- Chars => Name_Import,
+ Chars => Name_Import,
Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
Expression => Make_Identifier (Loc, Name_Ada)),
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 68a340d7c479..2ae1b5619076 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
@@ -513,7 +513,7 @@ package body Exp_Prag is
Insert_After_And_Analyze (N,
Make_Pragma (Loc,
- Chars => Name_Machine_Attribute,
+ Chars => Name_Machine_Attribute,
Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Iloc,
Expression => New_Copy_Tree (Internal)),
@@ -644,44 +644,38 @@ package body Exp_Prag is
(UI_To_Int (Exception_Code (Id)) / 8 * 8);
Excep_Alias :=
- Make_Pragma
- (Loc,
- Name_Linker_Alias,
- New_List
- (Make_Pragma_Argument_Association
- (Sloc => Loc,
- Expression =>
- New_Reference_To (Excep_Internal, Loc)),
-
- Make_Pragma_Argument_Association
- (Sloc => Loc,
- Expression =>
- Make_String_Literal
- (Sloc => Loc,
- Strval => End_String))));
+ Make_Pragma (Loc,
+ Chars => Name_Linker_Alias,
+ Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression =>
+ New_Reference_To (Excep_Internal, Loc)),
+
+ Make_Pragma_Argument_Association (Loc,
+ Expression =>
+ Make_String_Literal (Loc, End_String))));
Insert_Action (N, Excep_Alias);
Analyze (Excep_Alias);
Export_Pragma :=
- Make_Pragma
- (Loc,
- Name_Export,
- New_List
- (Make_Pragma_Argument_Association (Loc,
- Expression => Make_Identifier (Loc, Name_C)),
-
- Make_Pragma_Argument_Association (Loc,
- Expression =>
- New_Reference_To (Excep_Internal, Loc)),
-
- Make_Pragma_Argument_Association (Loc,
- Expression =>
- Make_String_Literal (Loc, Excep_Image)),
-
- Make_Pragma_Argument_Association (Loc,
- Expression =>
- Make_String_Literal (Loc, Excep_Image))));
+ Make_Pragma (Loc,
+ Chars => Name_Export,
+ Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Make_Identifier (Loc, Name_C)),
+
+ Make_Pragma_Argument_Association (Loc,
+ Expression =>
+ New_Reference_To (Excep_Internal, Loc)),
+
+ Make_Pragma_Argument_Association (Loc,
+ Expression =>
+ Make_String_Literal (Loc, Excep_Image)),
+
+ Make_Pragma_Argument_Association (Loc,
+ Expression =>
+ Make_String_Literal (Loc, Excep_Image))));
Insert_Action (N, Export_Pragma);
Analyze (Export_Pragma);
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 6cd4b7bff37e..b776ce7b0abd 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -6181,15 +6181,18 @@ message @code{warning: 960 bits of "a" unused}. No other regular
expression notations are permitted. All characters other than asterisk in
these three specific cases are treated as literal characters in the match.
-@noindent
-The fourth form also works for the additional warnings of the `GCC' back end,
-but the string must again be a single full `-W' switch in this case. Note that
-the message issued for these warnings explicitly lists the full `-W' switch
-they are associated with.
+The above use of patterns to match the message applies only to warning
+messages generated by the front end. This form of the pragma with a
+string argument can also be used to control back end warnings controlled
+by a "-Wxxx" switch. Such warnings can be identified by the appearence
+of a string of the form "[-Wxxx]" in the message which identifies the
+"-W" switch that controls the message. By using the text of the
+"-W" switch in the pragma, such back end warnings can be turned on and off.
There are two ways to use the pragma in this form. The OFF form can be used as a
configuration pragma. The effect is to suppress all warnings (if any)
-that match the pattern string throughout the compilation.
+that match the pattern string throughout the compilation (or match the
+-W switch in the back end case).
The second usage is to suppress a warning locally, and in this case, two
pragmas must appear in sequence:
diff --git a/gcc/ada/s-multip.adb b/gcc/ada/s-multip.adb
index ea1f15c06a9e..901cda0c6543 100644
--- a/gcc/ada/s-multip.adb
+++ b/gcc/ada/s-multip.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2010, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2013, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@@ -30,16 +30,22 @@ with Interfaces.C; use Interfaces.C;
package body System.Multiprocessors is
- function Gnat_Number_Of_CPUs return int;
- pragma Import (C, Gnat_Number_Of_CPUs, "__gnat_number_of_cpus");
-
--------------------
-- Number_Of_CPUs --
--------------------
function Number_Of_CPUs return CPU is
begin
- return CPU (Gnat_Number_Of_CPUs);
+ if CPU'Last = 1 then
+ return 1;
+ else
+ declare
+ function Gnat_Number_Of_CPUs return int;
+ pragma Import (C, Gnat_Number_Of_CPUs, "__gnat_number_of_cpus");
+ begin
+ return CPU (Gnat_Number_Of_CPUs);
+ end;
+ end if;
end Number_Of_CPUs;
end System.Multiprocessors;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index f2bcfa84adb8..63c4d089006a 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
@@ -843,7 +843,9 @@ package body Sem_Ch13 is
Prag :=
Make_Pragma (Loc,
Pragma_Argument_Associations => New_List (
- New_Occurrence_Of (Ent, Sloc (Ident))),
+ Make_Pragma_Argument_Association (Sloc (Ident),
+ Expression => New_Occurrence_Of (Ent, Sloc (Ident)))),
+
Pragma_Identifier =>
Make_Identifier (Sloc (Ident), Chars (Ident)));
@@ -1212,21 +1214,29 @@ package body Sem_Ch13 is
Aitem :=
Make_Pragma (Loc,
Pragma_Argument_Associations => New_List (
- New_Occurrence_Of (E, Loc),
- Relocate_Node (Expr)),
+ Make_Pragma_Argument_Association (Loc,
+ Expression => New_Occurrence_Of (E, Loc)),
+
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr))),
+
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Chars (Id)));
when Aspect_Synchronization =>
-- The aspect corresponds to pragma Implemented.
- -- Construct the pragma
+ -- Construct the pragma.
Aitem :=
Make_Pragma (Loc,
Pragma_Argument_Associations => New_List (
- New_Occurrence_Of (E, Loc),
- Relocate_Node (Expr)),
+ Make_Pragma_Argument_Association (Loc,
+ Expression => New_Occurrence_Of (E, Loc)),
+
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr))),
+
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Name_Implemented));
@@ -1241,8 +1251,11 @@ package body Sem_Ch13 is
Make_Pragma (Loc,
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Name_Attach_Handler),
- Pragma_Argument_Associations =>
- New_List (Ent, Relocate_Node (Expr)));
+ Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Sloc (Ent),
+ Expression => Ent),
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr))));
when Aspect_Dynamic_Predicate |
Aspect_Predicate |
@@ -1253,8 +1266,11 @@ package body Sem_Ch13 is
Aitem :=
Make_Pragma (Loc,
- Pragma_Argument_Associations =>
- New_List (Ent, Relocate_Node (Expr)),
+ Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Sloc (Ent),
+ Expression => Ent),
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr))),
Class_Present => Class_Present (Aspect),
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Name_Predicate));
@@ -1305,8 +1321,7 @@ package body Sem_Ch13 is
while Present (A) loop
A_Name := Chars (Identifier (A));
- if A_Name = Name_Import
- or else
+ if A_Name = Name_Import or else
A_Name = Name_Export
then
if Found then
@@ -1333,7 +1348,11 @@ package body Sem_Ch13 is
Next (A);
end loop;
- Arg_List := New_List (Relocate_Node (Expr), Ent);
+ Arg_List := New_List (
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr)),
+ Make_Pragma_Argument_Association (Sloc (Ent),
+ Expression => Ent));
if Present (L_Assoc) then
Append_To (Arg_List, L_Assoc);
@@ -1361,8 +1380,9 @@ package body Sem_Ch13 is
if Nkind (N) = N_Subprogram_Body then
Aitem :=
Make_Pragma (Loc,
- Pragma_Argument_Associations =>
- New_List (Relocate_Node (Expr)),
+ Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr))),
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Chars (Id)));
else
@@ -1380,8 +1400,10 @@ package body Sem_Ch13 is
Aitem :=
Make_Pragma (Loc,
Pragma_Argument_Associations => New_List (
- Relocate_Node (Expr),
- New_Occurrence_Of (E, Loc)),
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr)),
+ Make_Pragma_Argument_Association (Loc,
+ Expression => New_Occurrence_Of (E, Loc))),
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Chars (Id)),
Class_Present => Class_Present (Aspect));
@@ -1409,8 +1431,11 @@ package body Sem_Ch13 is
Aitem :=
Make_Pragma (Loc,
- Pragma_Argument_Associations =>
- New_List (Ent, Relocate_Node (Expr)),
+ Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Sloc (Ent),
+ Expression => Ent),
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr))),
Class_Present => Class_Present (Aspect),
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Name_Invariant));
@@ -1661,6 +1686,7 @@ package body Sem_Ch13 is
when Aspect_Contract_Case |
Aspect_Test_Case =>
+
declare
Args : List_Id;
Comp_Expr : Node_Id;
@@ -1692,10 +1718,9 @@ package body Sem_Ch13 is
while Present (Comp_Expr) loop
New_Expr := Relocate_Node (Comp_Expr);
Set_Original_Node (New_Expr, Comp_Expr);
- Append
- (Make_Pragma_Argument_Association (Sloc (Comp_Expr),
- Expression => New_Expr),
- Args);
+ Append_To (Args,
+ Make_Pragma_Argument_Association (Sloc (Comp_Expr),
+ Expression => New_Expr));
Next (Comp_Expr);
end loop;
@@ -1713,11 +1738,10 @@ package body Sem_Ch13 is
New_Expr := Relocate_Node (Expression (Comp_Assn));
Set_Original_Node (New_Expr, Expression (Comp_Assn));
- Append (Make_Pragma_Argument_Association (
- Sloc => Sloc (Comp_Assn),
+ Append_To (Args,
+ Make_Pragma_Argument_Association (Sloc (Comp_Assn),
Chars => Chars (First (Choices (Comp_Assn))),
- Expression => New_Expr),
- Args);
+ Expression => New_Expr));
Next (Comp_Assn);
end loop;
@@ -1893,7 +1917,9 @@ package body Sem_Ch13 is
if No (Expr) then
Aitem :=
Make_Pragma (Loc,
- Pragma_Argument_Associations => New_List (Ent),
+ Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Sloc (Ent),
+ Expression => Ent)),
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Chars (Id)));
@@ -1940,7 +1966,9 @@ package body Sem_Ch13 is
if Is_True (Static_Boolean (Expr)) then
Aitem :=
Make_Pragma (Loc,
- Pragma_Argument_Associations => New_List (Ent),
+ Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Sloc (Ent),
+ Expression => Ent)),
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Chars (Id)));
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index f5e0bec769f7..532b2b2035d6 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -9060,17 +9060,16 @@ package body Sem_Ch3 is
Impl_Prag :=
Make_Pragma (Loc,
- Chars => Name_Implemented,
+ Chars => Name_Implemented,
Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
- Expression =>
- New_Reference_To (Subp, Loc)),
+ Expression => New_Reference_To (Subp, Loc)),
Make_Pragma_Argument_Association (Loc,
Expression => Make_Identifier (Loc, Iface_Kind))));
-- The pragma doesn't need to be analyzed because it is internally
- -- build. It is safe to directly register it as a rep item since we
+ -- built. It is safe to directly register it as a rep item since we
-- are only interested in the characters of the implementation kind.
Record_Rep_Item (Subp, Impl_Prag);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 4e63afea97e9..b6db1ce6be62 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -11763,7 +11763,7 @@ package body Sem_Ch6 is
if not Expander_Active then
CP :=
Make_Pragma (Loc,
- Chars => Name_Postcondition,
+ Chars => Name_Postcondition,
Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
Chars => Name_Check,
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index c7e340a3db0a..1bbd358f2a99 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -7289,8 +7289,7 @@ package body Sem_Prag is
Rewrite (N,
Make_Pragma (Loc,
- Chars => Name_Check_Policy,
-
+ Chars => Name_Check_Policy,
Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
Expression => Make_Identifier (Loc, Name_Assertion)),
@@ -8436,11 +8435,10 @@ package body Sem_Prag is
Rewrite (N,
Make_Pragma (Loc,
Chars => Name_Import,
- Pragma_Argument_Associations =>
- New_List (
- Make_Pragma_Argument_Association (Loc,
- Expression => Make_Identifier (Loc, Name_CPP)),
- New_Copy (First (Pragma_Argument_Associations (N))))));
+ Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Make_Identifier (Loc, Name_CPP)),
+ New_Copy (First (Pragma_Argument_Associations (N))))));
Analyze (N);
end CPP_Class;
@@ -13485,7 +13483,7 @@ package body Sem_Prag is
if In_Body then
Rewrite (N,
Make_Pragma (Loc,
- Chars => Name_Check,
+ Chars => Name_Check,
Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
Expression => Make_Identifier (Loc, Name_Precondition)),
--
GitLab