diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f8a0188dac2e9d7967ed6b7bea0b799170f02087..4ab64a9e923630031221c9b1363e0c1869601540 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 560ceb7d33ee8b859acc39a2572e7b3ca8199884..e2d2446e500f1f53313ea90eda80b9457ff46cb1 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 1147724c91e3624a856f175cf48fcbeaf6c650cb..54442db72b4e7e899cc4fbaf4368b72178aa8103 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 8649fafff54f48202d8f28bc287f7f0690a4157a..e0e7250a3b765153fad0895085d05f1e9b8efe58 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 f86cbe5e24868d262560bedb0bda7eaa7d2f4a0d..2d0d817fc8a18ab217919c0ce3e569270ec5969f 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 68a340d7c4791eb1b95a152312ff33282647dd0a..2ae1b5619076ad8519401711fe7dd894ce49bf38 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 6cd4b7bff37ef9d7f7238ae1269f7c2508247a6a..b776ce7b0abdb25d46e627428fc2add1f69a0091 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 ea1f15c06a9eb4e9d4f5ebc1010b82178b76c830..901cda0c6543f74d9163dee7c354e507d0812188 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 f2bcfa84adb8ea945da3359577775f6f2941070a..63c4d089006a1e7e3230a9a48b65996dd2049ecc 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 f5e0bec769f707e0615de619fa3a75f8adbfd338..532b2b2035d6c38b32e82a43cba7dab905f0fa8a 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 4e63afea97e9ad80a63dab60e735d87762ff34ce..b6db1ce6be6261075f3590b8fff1064d6322c802 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 c7e340a3db0a4a4b9143c3016a979ab9704b41d4..1bbd358f2a992cd77439fe155d597467f826e2ff 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)),