procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
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
This commit is contained in:
Arnaud Charlet 2013-02-06 11:05:12 +01:00
parent c4e1d59df2
commit 3860d46902
12 changed files with 153 additions and 93 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
gcc/ada/ChangeLog
View file

@ -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

17
gcc/ada/clean.adb
View file

@ -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

4
gcc/ada/exp_attr.adb
View file

@ -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),

4
gcc/ada/exp_dist.adb
View file

@ -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,

4
gcc/ada/exp_intr.adb
View file

@ -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)),

56
gcc/ada/exp_prag.adb
View file

@ -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 (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
(Sloc => Loc,
Expression =>
Make_String_Literal
(Sloc => Loc,
Strval => End_String))));
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 (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 =>
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_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);

15
gcc/ada/gnat_rm.texi
View file

@ -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:

16
gcc/ada/s-multip.adb
View file

@ -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;

88
gcc/ada/sem_ch13.adb
View file

@ -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)));

7
gcc/ada/sem_ch3.adb
View file

@ -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);

2
gcc/ada/sem_ch6.adb
View file

@ -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,

14
gcc/ada/sem_prag.adb
View file

@ -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)),