Commit d27f3ff4 by Arnaud Charlet

[multiple changes]

2012-07-09  Robert Dewar  <dewar@adacore.com>

	* freeze.adb: Minor code reorganization (use Ekind_In).
	* exp_attr.adb, sem_ch9.adb par-ch4.adb, s-taprop-mingw.adb,
	sem_attr.adb, exp_ch8.adb, snames.adb-tmpl, par-util.adb,
	sem_ch13.adb, snames.ads-tmpl: Minor reformatting.

2012-07-09  Tristan Gingold  <gingold@adacore.com>

	* raise-gcc.c: Adjust previous patch.

2012-07-09  Vincent Celier  <celier@adacore.com>

	* make.adb (Compilation_Phase): Do not build libraries in
	Codepeer mode (do not call Library_Phase).

From-SVN: r189379
parent d48f3dca
2012-07-09 Robert Dewar <dewar@adacore.com>
* freeze.adb: Minor code reorganization (use Ekind_In).
* exp_attr.adb, sem_ch9.adb par-ch4.adb, s-taprop-mingw.adb,
sem_attr.adb, exp_ch8.adb, snames.adb-tmpl, par-util.adb,
sem_ch13.adb, snames.ads-tmpl: Minor reformatting.
2012-07-09 Tristan Gingold <gingold@adacore.com>
* raise-gcc.c: Adjust previous patch.
2012-07-09 Vincent Celier <celier@adacore.com>
* make.adb (Compilation_Phase): Do not build libraries in
Codepeer mode (do not call Library_Phase).
2012-07-09 Ed Schonberg <schonberg@adacore.com> 2012-07-09 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb: Extend previous change to elementary types. * sem_ch13.adb: Extend previous change to elementary types.
......
...@@ -838,8 +838,8 @@ package body Exp_Attr is ...@@ -838,8 +838,8 @@ package body Exp_Attr is
Attribute_Variable_Indexing => Attribute_Variable_Indexing =>
null; null;
-- Internal attributes used to deal with Ada 2012 delayed aspects -- Internal attributes used to deal with Ada 2012 delayed aspects. These
-- (already diagnosed by parser, thus nothing more to do here). -- were already rejected by the parser. Thus they shouldn't appear here.
when Attribute_CPU | when Attribute_CPU |
Attribute_Dispatching_Domain | Attribute_Dispatching_Domain |
......
...@@ -243,8 +243,12 @@ package body Exp_Ch8 is ...@@ -243,8 +243,12 @@ package body Exp_Ch8 is
Id : constant Entity_Id := Defining_Entity (N); Id : constant Entity_Id := Defining_Entity (N);
function Build_Body_For_Renaming return Node_Id; function Build_Body_For_Renaming return Node_Id;
-- Build and return the body for the renaming declaration of an -- Build and return the body for the renaming declaration of an equality
-- equality or unequality operator. -- or inequality operator.
-----------------------------
-- Build_Body_For_Renaming --
-----------------------------
function Build_Body_For_Renaming return Node_Id is function Build_Body_For_Renaming return Node_Id is
Body_Id : Entity_Id; Body_Id : Entity_Id;
...@@ -275,10 +279,12 @@ package body Exp_Ch8 is ...@@ -275,10 +279,12 @@ package body Exp_Ch8 is
return Decl; return Decl;
end Build_Body_For_Renaming; end Build_Body_For_Renaming;
-- Local variable -- Local variables
Nam : constant Node_Id := Name (N); Nam : constant Node_Id := Name (N);
-- Start of processing for Expand_N_Subprogram_Renaming_Declaration
begin begin
-- When the prefix of the name is a function call, we must force the -- When the prefix of the name is a function call, we must force the
-- call to be made by removing side effects from the call, since we -- call to be made by removing side effects from the call, since we
...@@ -334,9 +340,9 @@ package body Exp_Ch8 is ...@@ -334,9 +340,9 @@ package body Exp_Ch8 is
Expression => Expression =>
Expand_Record_Equality Expand_Record_Equality
(Id, (Id,
Typ => Typ, Typ => Typ,
Lhs => Make_Identifier (Loc, Chars (Left)), Lhs => Make_Identifier (Loc, Chars (Left)),
Rhs => Make_Identifier (Loc, Chars (Right)), Rhs => Make_Identifier (Loc, Chars (Right)),
Bodies => Declarations (Decl)))))); Bodies => Declarations (Decl))))));
Append (Decl, List_Containing (N)); Append (Decl, List_Containing (N));
......
...@@ -1908,8 +1908,8 @@ package body Freeze is ...@@ -1908,8 +1908,8 @@ package body Freeze is
begin begin
-- Deal with delayed aspect specifications for components. The -- Deal with delayed aspect specifications for components. The
-- analysis of the aspect is required to be delayed to the freeze -- analysis of the aspect is required to be delayed to the freeze
-- point, thus we analyze the pragma or attribute definition clause -- point, thus we analyze the pragma or attribute definition
-- in the tree at this point. We also analyze the aspect -- clause in the tree at this point. We also analyze the aspect
-- specification node at the freeze point when the aspect doesn't -- specification node at the freeze point when the aspect doesn't
-- correspond to pragma/attribute definition clause. -- correspond to pragma/attribute definition clause.
...@@ -1955,9 +1955,7 @@ package body Freeze is ...@@ -1955,9 +1955,7 @@ package body Freeze is
-- Handle the component and discriminant case -- Handle the component and discriminant case
if Ekind (Comp) = E_Component if Ekind_In (Comp, E_Component, E_Discriminant) then
or else Ekind (Comp) = E_Discriminant
then
declare declare
CC : constant Node_Id := Component_Clause (Comp); CC : constant Node_Id := Component_Clause (Comp);
......
...@@ -4811,6 +4811,7 @@ package body Make is ...@@ -4811,6 +4811,7 @@ package body Make is
-- have been regenerated. -- have been regenerated.
if Main_Project /= No_Project if Main_Project /= No_Project
and then not Codepeer_Mode
and then MLib.Tgt.Support_For_Libraries /= Prj.None and then MLib.Tgt.Support_For_Libraries /= Prj.None
and then (Do_Bind_Step and then (Do_Bind_Step
or Unique_Compile_All_Projects or Unique_Compile_All_Projects
......
...@@ -435,7 +435,8 @@ package body Ch4 is ...@@ -435,7 +435,8 @@ package body Ch4 is
Attr_Name := Token_Name; Attr_Name := Token_Name;
-- Note that internal attributes names don't denote real -- Note that internal attributes names don't denote real
-- attribute. -- attributes, so do not count in this error test. We just
-- want to consider them as not being attribute names.
if not Is_Attribute_Name (Attr_Name) if not Is_Attribute_Name (Attr_Name)
or else Is_Internal_Attribute_Name (Attr_Name) or else Is_Internal_Attribute_Name (Attr_Name)
......
...@@ -721,8 +721,9 @@ package body Util is ...@@ -721,8 +721,9 @@ package body Util is
Error_Msg_Name_1 := First_Attribute_Name; Error_Msg_Name_1 := First_Attribute_Name;
while Error_Msg_Name_1 <= Last_Attribute_Name loop while Error_Msg_Name_1 <= Last_Attribute_Name loop
-- No mispelling possible with internal attribute names since they -- No mispelling possible with internal attribute names since they
-- don't denote real attribute. -- don't denote real attributes.
if not Is_Internal_Attribute_Name (Error_Msg_Name_1) if not Is_Internal_Attribute_Name (Error_Msg_Name_1)
and then Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1) and then Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1)
......
...@@ -1167,7 +1167,7 @@ __gnat_cleanupunwind_handler (int version, ...@@ -1167,7 +1167,7 @@ __gnat_cleanupunwind_handler (int version,
{ {
/* Terminate when the end of the stack is reached. */ /* Terminate when the end of the stack is reached. */
if ((phases & _UA_END_OF_STACK) != 0 if ((phases & _UA_END_OF_STACK) != 0
#if defined (__ia64__) && defined (USE_LIBUNWIND_EXCEPTIONS) #if defined (__ia64__) && defined (__hpux__)
/* Strictely follow the ia64 ABI: when end of stack is reached, /* Strictely follow the ia64 ABI: when end of stack is reached,
the callback will be called with a NULL stack pointer. the callback will be called with a NULL stack pointer.
No need for that when using libgcc unwinder. */ No need for that when using libgcc unwinder. */
......
...@@ -725,15 +725,17 @@ package body System.Task_Primitives.Operations is ...@@ -725,15 +725,17 @@ package body System.Task_Primitives.Operations is
pragma Unreferenced (Loss_Of_Inheritance); pragma Unreferenced (Loss_Of_Inheritance);
begin begin
Res := SetThreadPriority Res :=
(T.Common.LL.Thread, Interfaces.C.int (Underlying_Priorities (Prio))); SetThreadPriority
(T.Common.LL.Thread,
Interfaces.C.int (Underlying_Priorities (Prio)));
pragma Assert (Res = Win32.TRUE); pragma Assert (Res = Win32.TRUE);
-- Note: Annex D (RM D.2.3(5/2)) requires the task to be placed at the -- Note: Annex D (RM D.2.3(5/2)) requires the task to be placed at the
-- head of its priority queue when decreasing its priority as a result -- head of its priority queue when decreasing its priority as a result
-- of a loss of inherited priority. This is not the case, but we -- of a loss of inherited priority. This is not the case, but we
-- consider it an acceptable variation (RM 1.1.3(6)), given this is the -- consider it an acceptable variation (RM 1.1.3(6)), given this is
-- built-in behavior offered by the Windows operating system. -- the built-in behavior offered by the Windows operating system.
-- In older versions we attempted to better approximate the Annex D -- In older versions we attempted to better approximate the Annex D
-- required behavior, but this simulation was not entirely accurate, -- required behavior, but this simulation was not entirely accurate,
......
...@@ -2215,8 +2215,8 @@ package body Sem_Attr is ...@@ -2215,8 +2215,8 @@ package body Sem_Attr is
Attribute_Variable_Indexing => Attribute_Variable_Indexing =>
Error_Msg_N ("illegal attribute", N); Error_Msg_N ("illegal attribute", N);
-- Internal attributes used to deal with Ada 2012 delayed aspects -- Internal attributes used to deal with Ada 2012 delayed aspects. These
-- (already diagnosed by parser, thus nothing more to do here). -- were already rejected by the parser. Thus they shouldn't appear here.
when Attribute_CPU | when Attribute_CPU |
Attribute_Dispatching_Domain | Attribute_Dispatching_Domain |
......
...@@ -7741,6 +7741,7 @@ package body Sem_Ch13 is ...@@ -7741,6 +7741,7 @@ package body Sem_Ch13 is
and then Siz > UI_From_Int (Int'Last) and then Siz > UI_From_Int (Int'Last)
then then
Error_Msg_N ("Size value too large for elementary type", N); Error_Msg_N ("Size value too large for elementary type", N);
if Nkind (Original_Node (N)) = N_Op_Expon then if Nkind (Original_Node (N)) = N_Op_Expon then
Error_Msg_N Error_Msg_N
("\maybe '* was meant, rather than '*'*", Original_Node (N)); ("\maybe '* was meant, rather than '*'*", Original_Node (N));
......
...@@ -138,8 +138,7 @@ package body Sem_Ch9 is ...@@ -138,8 +138,7 @@ package body Sem_Ch9 is
Pdef : constant Node_Id := Protected_Definition (N); Pdef : constant Node_Id := Protected_Definition (N);
Priv_Decls : constant List_Id := Private_Declarations (Pdef); Priv_Decls : constant List_Id := Private_Declarations (Pdef);
Vis_Decls : constant List_Id := Visible_Declarations (Pdef); Vis_Decls : constant List_Id := Visible_Declarations (Pdef);
Decl : Node_Id;
Decl : Node_Id;
begin begin
-- Examine the visible and the private declarations -- Examine the visible and the private declarations
...@@ -152,8 +151,8 @@ package body Sem_Ch9 is ...@@ -152,8 +151,8 @@ package body Sem_Ch9 is
if Nkind (Decl) = N_Entry_Declaration then if Nkind (Decl) = N_Entry_Declaration then
if Complain then if Complain then
Error_Msg_N ("entry not allowed when Lock_Free given", Error_Msg_N
Decl); ("entry not allowed when Lock_Free given", Decl);
end if; end if;
return False; return False;
...@@ -162,10 +161,10 @@ package body Sem_Ch9 is ...@@ -162,10 +161,10 @@ package body Sem_Ch9 is
-- allowed by the lock-free restrictions. -- allowed by the lock-free restrictions.
elsif Nkind (Decl) = N_Subprogram_Declaration elsif Nkind (Decl) = N_Subprogram_Declaration
and then Nkind (Specification (Decl)) = and then
N_Procedure_Specification Nkind (Specification (Decl)) = N_Procedure_Specification
and then Present and then
(Parameter_Specifications (Specification (Decl))) Present (Parameter_Specifications (Specification (Decl)))
then then
declare declare
Par_Specs : constant List_Id := Par_Specs : constant List_Id :=
...@@ -192,8 +191,7 @@ package body Sem_Ch9 is ...@@ -192,8 +191,7 @@ package body Sem_Ch9 is
end; end;
end if; end if;
-- Examine the private declarations after the visible -- Examine private declarations after visible declarations
-- declarations.
if No (Next (Decl)) if No (Next (Decl))
and then List_Containing (Decl) = Vis_Decls and then List_Containing (Decl) = Vis_Decls
...@@ -433,14 +431,13 @@ package body Sem_Ch9 is ...@@ -433,14 +431,13 @@ package body Sem_Ch9 is
begin begin
Decl := First (Decls); Decl := First (Decls);
while Present (Decl) loop while Present (Decl) loop
if Nkind (Decl) = N_Subprogram_Body if Nkind (Decl) = N_Subprogram_Body
and then not Satisfies_Lock_Free_Requirements (Decl) and then not Satisfies_Lock_Free_Requirements (Decl)
then then
if Complain then if Complain then
Error_Msg_N ("body not allowed when Lock_Free given", Error_Msg_N
Decl); ("body not allowed when Lock_Free given", Decl);
end if; end if;
return False; return False;
...@@ -479,7 +476,7 @@ package body Sem_Ch9 is ...@@ -479,7 +476,7 @@ package body Sem_Ch9 is
else else
if Ada_Version >= Ada_2005 then if Ada_Version >= Ada_2005 then
Error_Msg_N ("expect task name or task interface class-wide " Error_Msg_N ("expect task name or task interface class-wide "
& "object for ABORT", T_Name); & "object for ABORT", T_Name);
else else
Error_Msg_N ("expect task name for ABORT", T_Name); Error_Msg_N ("expect task name for ABORT", T_Name);
end if; end if;
...@@ -1782,13 +1779,14 @@ package body Sem_Ch9 is ...@@ -1782,13 +1779,14 @@ package body Sem_Ch9 is
-- issued by Allows_Lock_Free_Implementation. -- issued by Allows_Lock_Free_Implementation.
if Uses_Lock_Free (Defining_Identifier (N)) then if Uses_Lock_Free (Defining_Identifier (N)) then
-- Complain when there is an explicit aspect/pragma Priority (or -- Complain when there is an explicit aspect/pragma Priority (or
-- Interrupt_Priority) while the lock-free implementation is forced -- Interrupt_Priority) while the lock-free implementation is forced
-- by an aspect/pragma. -- by an aspect/pragma.
declare declare
Id : constant Entity_Id := Id : constant Entity_Id :=
Defining_Identifier (Original_Node (N)); Defining_Identifier (Original_Node (N));
-- The warning must be issued on the original identifier in order -- The warning must be issued on the original identifier in order
-- to deal properly with the case of a single protected object. -- to deal properly with the case of a single protected object.
...@@ -1800,6 +1798,7 @@ package body Sem_Ch9 is ...@@ -1800,6 +1798,7 @@ package body Sem_Ch9 is
begin begin
if Present (Prio_Item) then if Present (Prio_Item) then
-- Aspect case -- Aspect case
if Nkind (Prio_Item) = N_Aspect_Specification if Nkind (Prio_Item) = N_Aspect_Specification
......
...@@ -398,9 +398,10 @@ package body Snames is ...@@ -398,9 +398,10 @@ package body Snames is
function Is_Internal_Attribute_Name (N : Name_Id) return Boolean is function Is_Internal_Attribute_Name (N : Name_Id) return Boolean is
begin begin
return N = Name_CPU return
or N = Name_Interrupt_Priority N = Name_CPU or else
or N = Name_Dispatching_Domain; N = Name_Interrupt_Priority or else
N = Name_Dispatching_Domain;
end Is_Internal_Attribute_Name; end Is_Internal_Attribute_Name;
---------------------------- ----------------------------
......
...@@ -754,9 +754,12 @@ package Snames is ...@@ -754,9 +754,12 @@ package Snames is
-- section in Sem_Attr. -- section in Sem_Attr.
-- The entries marked INT are not real attributes. They are special names -- The entries marked INT are not real attributes. They are special names
-- used internally by GNAT in order to deal with delayed aspects -- used internally by GNAT in order to deal with certain delayed aspects
-- (Aspect_CPU, Aspect_Dispatching_Domain, Aspect_Interrupt_Priority) that -- (Aspect_CPU, Aspect_Dispatching_Domain, Aspect_Interrupt_Priority) that
-- don't have corresponding pragma or attribute. -- don't have corresponding pragmas or user-referencable attributes. It is
-- convenient to have these internal attributes available in processing
-- the aspects, since the normal approach is to convert an aspect into its
-- corresponding pragma or attribute specification.
-- The entries marked VMS are recognized only in OpenVMS implementations -- The entries marked VMS are recognized only in OpenVMS implementations
-- of GNAT, and are treated as illegal in all other contexts. -- of GNAT, and are treated as illegal in all other contexts.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment