+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
-- --
-- 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- --
-- 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
-- --
-- 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- --
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),
-- --
-- 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- --
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,
-- --
-- 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- --
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)),
-- --
-- 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- --
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)),
(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);
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:
-- --
-- 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- --
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;
-- --
-- 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- --
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)));
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));
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 |
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));
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
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);
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
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));
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));
when Aspect_Contract_Case |
Aspect_Test_Case =>
+
declare
Args : List_Id;
Comp_Expr : Node_Id;
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;
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;
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)));
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)));
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);
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,
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)),
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;
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)),