Commit e192a2cd by Arnaud Charlet

[multiple changes]

2011-10-13  Thomas Quinot  <quinot@adacore.com>

	* par-ch2.adb, par.adb, par-util.adb, par-ch3.adb
	(Check_Future_Identifier): New subprogram,
	factors duplicated code from Par.Ch2.P_Identifier and
	Par.Ch3.P_Defining_Identifier.

2011-10-13  Thomas Quinot  <quinot@adacore.com>

	* s-taprop-posix.adb (Initialize): Always raise Storage_Error
	if we fail to initialize CV attributes or CV.

2011-10-13  Thomas Quinot  <quinot@adacore.com>

	* s-tasren.adb (Timed_Selective_Wait, case
	Accept_Alternative_Selected): Use Defer_Abort_Nestable, since
	we know abortion is already deferred.

2011-10-13  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch3.adb (Build_Class_Wide_Master): Moved to exp_ch9.
	(Build_Master_Renaming (function)): Removed.
	(Build_Master_Renaming (procedure)): Moved to exp_ch9.
	(Expand_Full_Type_Declaration): Alphabetize
	variables. Reformatting of code and comments. Rewrite the
	section on processing of anonymous access-to-task types in
	record components.
	* exp_ch3.ads (Build_Class_Wide_Master): Moved to exp_ch9.
	(Build_Master_Renaming): Moved to exp_ch9.
	* exp_ch9.adb (Build_Class_Wide_Master): Moved from exp_ch3.
	(Build_Master_Entity): Add formal parameter
	Use_Current. Reformatting of code and comments.
	(Build_Master_Renaming): Moved from exp_ch3.
	* exp_ch9.ads (Build_Class_Wide_Master): Moved from
	exp_ch3. Update comment on usage.
	(Build_Master_Entity):
	Add formal parameter Use_Current. Update comment on usage.
	(Build_Master_Renaming): Moved from exp_ch3.
	* sem_ch3.adb (Access_Definition): Remove redundant code to
	create a _master and a renaming.

2011-10-13  Ed Schonberg  <schonberg@adacore.com>

	* lib-xref.adb: Do no emit reference to overridden operation,
	if it is internally generated.

2011-10-13  Vincent Celier  <celier@adacore.com>

	* bindgen.adb: Remove any processing related to g-trasym
	* Makefile.rtl: Add g-trasym.o to GNATRTL_NONTASKING_OBJS
	* mlib-prj.adb: Remove any processing related to g-trasym.

From-SVN: r179898
parent 54c42edf
2011-10-13 Thomas Quinot <quinot@adacore.com>
* par-ch2.adb, par.adb, par-util.adb, par-ch3.adb
(Check_Future_Identifier): New subprogram,
factors duplicated code from Par.Ch2.P_Identifier and
Par.Ch3.P_Defining_Identifier.
2011-10-13 Thomas Quinot <quinot@adacore.com>
* s-taprop-posix.adb (Initialize): Always raise Storage_Error
if we fail to initialize CV attributes or CV.
2011-10-13 Thomas Quinot <quinot@adacore.com>
* s-tasren.adb (Timed_Selective_Wait, case
Accept_Alternative_Selected): Use Defer_Abort_Nestable, since
we know abortion is already deferred.
2011-10-13 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch3.adb (Build_Class_Wide_Master): Moved to exp_ch9.
(Build_Master_Renaming (function)): Removed.
(Build_Master_Renaming (procedure)): Moved to exp_ch9.
(Expand_Full_Type_Declaration): Alphabetize
variables. Reformatting of code and comments. Rewrite the
section on processing of anonymous access-to-task types in
record components.
* exp_ch3.ads (Build_Class_Wide_Master): Moved to exp_ch9.
(Build_Master_Renaming): Moved to exp_ch9.
* exp_ch9.adb (Build_Class_Wide_Master): Moved from exp_ch3.
(Build_Master_Entity): Add formal parameter
Use_Current. Reformatting of code and comments.
(Build_Master_Renaming): Moved from exp_ch3.
* exp_ch9.ads (Build_Class_Wide_Master): Moved from
exp_ch3. Update comment on usage.
(Build_Master_Entity):
Add formal parameter Use_Current. Update comment on usage.
(Build_Master_Renaming): Moved from exp_ch3.
* sem_ch3.adb (Access_Definition): Remove redundant code to
create a _master and a renaming.
2011-10-13 Ed Schonberg <schonberg@adacore.com>
* lib-xref.adb: Do no emit reference to overridden operation,
if it is internally generated.
2011-10-13 Vincent Celier <celier@adacore.com>
* bindgen.adb: Remove any processing related to g-trasym
* Makefile.rtl: Add g-trasym.o to GNATRTL_NONTASKING_OBJS
* mlib-prj.adb: Remove any processing related to g-trasym.
2011-10-12 Eric Botcazou <ebotcazou@adacore.com>
* sem_util.adb (Denotes_Same_Prefix): Fix fatal warning.
......
......@@ -435,6 +435,7 @@ GNATRTL_NONTASKING_OBJS= \
g-tasloc$(objext) \
g-timsta$(objext) \
g-traceb$(objext) \
g-trasym$(objext) \
g-u3spch$(objext) \
g-utf_32$(objext) \
g-wispch$(objext) \
......
......@@ -1893,25 +1893,6 @@ package body Bindgen is
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Eol;
end if;
-- Don't link with the shared library on VMS if an internal
-- filename object is seen. Multiply defined symbols will
-- result.
if OpenVMS_On_Target
and then Is_Internal_File_Name
(ALIs.Table
(Units.Table (Elab_Order.Table (E)).My_ALI).Sfile)
then
-- Special case for g-trasym.obj (not included in libgnat)
Get_Name_String (ALIs.Table
(Units.Table (Elab_Order.Table (E)).My_ALI).Sfile);
if Name_Buffer (1 .. 8) /= "g-trasym" then
Opt.Shared_Libgnat := False;
end if;
end if;
end if;
end if;
end loop;
......
......@@ -46,15 +46,6 @@ package Exp_Ch3 is
procedure Expand_Record_Extension (T : Entity_Id; Def : Node_Id);
-- Add a field _parent in the extension part of the record
procedure Build_Class_Wide_Master (T : Entity_Id);
-- For access to class-wide limited types we must build a task master
-- because some subsequent extension may add a task component. To avoid
-- bringing in the tasking run-time whenever an access-to-class-wide
-- limited type is used, we use the soft-link mechanism and add a level of
-- indirection to calls to routines that manipulate Master_Ids. This must
-- also be used for anonymous access types whose designated type is a task
-- or synchronized interface.
procedure Build_Discr_Checking_Funcs (N : Node_Id);
-- Builds function which checks whether the component name is consistent
-- with the current discriminants. N is the full type declaration node,
......@@ -93,19 +84,6 @@ package Exp_Ch3 is
-- Constructor_Ref is a call to a constructor subprogram. It is currently
-- used only to support C++ constructors.
procedure Build_Master_Renaming (N : Node_Id; T : Entity_Id);
-- If the designated type of an access type is a task type or contains
-- tasks, we make sure that a _Master variable is declared in the current
-- scope, and then declare a renaming for it:
--
-- atypeM : Master_Id renames _Master;
--
-- where atyp is the name of the access type. This declaration is
-- used when an allocator for the access type is expanded. The node N
-- is the full declaration of the designated type that contains tasks.
-- The renaming declaration is inserted before N, and after the Master
-- declaration.
function Freeze_Type (N : Node_Id) return Boolean;
-- This function executes the freezing actions associated with the given
-- freeze type node N and returns True if the node is to be deleted. We
......
......@@ -1073,6 +1073,128 @@ package body Exp_Ch9 is
Parameter_Associations => New_List (Concurrent_Ref (N)));
end Build_Call_With_Task;
-----------------------------
-- Build_Class_Wide_Master --
-----------------------------
procedure Build_Class_Wide_Master (Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (Typ);
Master_Id : Entity_Id;
Master_Scope : Entity_Id;
Name_Id : Node_Id;
Related_Node : Node_Id;
Ren_Decl : Node_Id;
begin
-- Nothing to do if there is no task hierarchy
if Restriction_Active (No_Task_Hierarchy) then
return;
end if;
-- Find the declaration that created the access type. It is either a
-- type declaration, or an object declaration with an access definition,
-- in which case the type is anonymous.
if Is_Itype (Typ) then
Related_Node := Associated_Node_For_Itype (Typ);
else
Related_Node := Parent (Typ);
end if;
Master_Scope := Find_Master_Scope (Typ);
-- Nothing to do if the master scope already contains a _master entity.
-- The only exception to this is the following scenario:
-- Source_Scope
-- Transient_Scope_1
-- _master
-- Transient_Scope_2
-- use of master
-- In this case the source scope is marked as having the master entity
-- even though the actual declaration appears inside an inner scope. If
-- the second transient scope requires a _master, it cannot use the one
-- already declared because the entity is not visible.
Name_Id := Make_Identifier (Loc, Name_uMaster);
if not Has_Master_Entity (Master_Scope)
or else No (Current_Entity_In_Scope (Name_Id))
then
declare
Master_Decl : Node_Id;
begin
Set_Has_Master_Entity (Master_Scope);
-- Generate:
-- _master : constant Integer := Current_Master.all;
Master_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uMaster),
Constant_Present => True,
Object_Definition =>
New_Reference_To (Standard_Integer, Loc),
Expression =>
Make_Explicit_Dereference (Loc,
New_Reference_To (RTE (RE_Current_Master), Loc)));
Insert_Action (Related_Node, Master_Decl);
Analyze (Master_Decl);
-- Mark the containing scope as a task master. Masters associated
-- with return statements are already marked at this stage (see
-- Analyze_Subprogram_Body).
if Ekind (Current_Scope) /= E_Return_Statement then
declare
Par : Node_Id := Related_Node;
begin
while Nkind (Par) /= N_Compilation_Unit loop
Par := Parent (Par);
-- If we fall off the top, we are at the outer level, and
-- the environment task is our effective master, so
-- nothing to mark.
if Nkind_In (Par, N_Block_Statement,
N_Subprogram_Body,
N_Task_Body)
then
Set_Is_Task_Master (Par);
exit;
end if;
end loop;
end;
end if;
end;
end if;
Master_Id :=
Make_Defining_Identifier (Loc,
New_External_Name (Chars (Typ), 'M'));
-- Generate:
-- Mnn renames _master;
Ren_Decl :=
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Master_Id,
Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
Name => Name_Id);
Insert_Before (Related_Node, Ren_Decl);
Analyze (Ren_Decl);
Set_Master_Id (Typ, Master_Id);
end Build_Class_Wide_Master;
--------------------------------
-- Build_Corresponding_Record --
--------------------------------
......@@ -2763,64 +2885,111 @@ package body Exp_Ch9 is
-- Build_Master_Entity --
-------------------------
procedure Build_Master_Entity (E : Entity_Id) is
Loc : constant Source_Ptr := Sloc (E);
P : Node_Id;
Decl : Node_Id;
S : Entity_Id;
procedure Build_Master_Entity
(Id : Entity_Id;
Use_Current : Boolean := False)
is
Loc : constant Source_Ptr := Sloc (Id);
Context : Node_Id;
Master_Decl : Node_Id;
Master_Scop : Entity_Id;
begin
S := Find_Master_Scope (E);
if Use_Current then
Master_Scop := Current_Scope;
else
Master_Scop := Find_Master_Scope (Id);
end if;
-- Nothing to do if we already built a master entity for this scope
-- or if there is no task hierarchy.
-- Do not create a master if the enclosing scope already has one or if
-- there is no task hierarchy.
if Has_Master_Entity (S)
if Has_Master_Entity (Master_Scop)
or else Restriction_Active (No_Task_Hierarchy)
then
return;
end if;
-- Otherwise first build the master entity
-- Determine the proper context to insert the master
if Is_Access_Type (Id) and then Is_Itype (Id) then
Context := Associated_Node_For_Itype (Id);
else
Context := Parent (Id);
end if;
-- Create a master, generate:
-- _Master : constant Master_Id := Current_Master.all;
-- and insert it just before the current declaration
Decl :=
Master_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uMaster),
Constant_Present => True,
Object_Definition => New_Reference_To (RTE (RE_Master_Id), Loc),
Expression =>
Constant_Present => True,
Object_Definition => New_Reference_To (RTE (RE_Master_Id), Loc),
Expression =>
Make_Explicit_Dereference (Loc,
New_Reference_To (RTE (RE_Current_Master), Loc)));
P := Parent (E);
Insert_Before (P, Decl);
Analyze (Decl);
Insert_Before (Context, Master_Decl);
Analyze (Master_Decl);
Set_Has_Master_Entity (S);
-- Mark the enclosing scope and its associated construct as being task
-- masters.
-- Now mark the containing scope as a task master
Set_Has_Master_Entity (Master_Scop);
while Nkind (P) /= N_Compilation_Unit loop
P := Parent (P);
while Nkind (Context) /= N_Compilation_Unit loop
Context := Parent (Context);
-- If we fall off the top, we are at the outer level, and the
-- environment task is our effective master, so nothing to mark.
if Nkind_In
(P, N_Task_Body, N_Block_Statement, N_Subprogram_Body)
if Nkind_In (Context, N_Block_Statement,
N_Subprogram_Body,
N_Task_Body)
then
Set_Is_Task_Master (P, True);
Set_Is_Task_Master (Context, True);
return;
elsif Nkind (Parent (P)) = N_Subunit then
P := Corresponding_Stub (Parent (P));
elsif Nkind (Parent (Context)) = N_Subunit then
Context := Corresponding_Stub (Parent (Context));
end if;
end loop;
end Build_Master_Entity;
---------------------------
-- Build_Master_Renaming --
---------------------------
procedure Build_Master_Renaming (N : Node_Id; Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (N);
Master_Decl : Node_Id;
Master_Id : Entity_Id;
begin
-- Nothing to do if there is no task hierarchy
if Restriction_Active (No_Task_Hierarchy) then
return;
end if;
Master_Id :=
Make_Defining_Identifier (Loc,
New_External_Name (Chars (Typ), 'M'));
Master_Decl :=
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Master_Id,
Subtype_Mark => New_Reference_To (RTE (RE_Master_Id), Loc),
Name => Make_Identifier (Loc, Name_uMaster));
Insert_Before (N, Master_Decl);
Analyze (Master_Decl);
Set_Master_Id (Typ, Master_Id);
end Build_Master_Renaming;
-----------------------------------------
-- Build_Private_Protected_Declaration --
-----------------------------------------
......
......@@ -50,28 +50,34 @@ package Exp_Ch9 is
-- Task_Id of the associated task as the parameter. The caller is
-- responsible for analyzing and resolving the resulting tree.
procedure Build_Class_Wide_Master (Typ : Entity_Id);
-- Given an access-to-limited class-wide type or an access-to-limited
-- interface, ensure that the designated type has a _master and generate
-- a renaming of the said master to service the access type.
function Build_Entry_Names (Conc_Typ : Entity_Id) return Node_Id;
-- Create the statements which populate the entry names array of a task or
-- protected type. The statements are wrapped inside a block due to a local
-- declaration.
procedure Build_Master_Entity (E : Entity_Id);
-- Given an entity E for the declaration of an object containing tasks
-- or of a type declaration for an allocator whose designated type is a
-- task or contains tasks, this routine marks the appropriate enclosing
-- context as a master, and also declares a variable called _Master in
-- the current declarative part which captures the value of Current_Master
-- (if not already built by a prior call). We build this object (instead
-- of just calling Current_Master) for two reasons. First it is clearly
-- more efficient to call Current_Master only once for a bunch of tasks
-- in the same declarative part, and second it makes things easier in
-- generating the initialization routines, since they can just reference
-- the object _Master by name, and they will get the proper Current_Master
-- value at the outer level, and copy in the parameter value for the outer
-- initialization call if the call is for a nested component). Note that
-- in the case of nested packages, we only really need to make one such
-- object at the outer level, but it is much easier to generate one per
-- declarative part.
procedure Build_Master_Entity
(Id : Entity_Id;
Use_Current : Boolean := False);
-- Given the name of an object or a type which is either a task, contains
-- tasks or designates tasks, create a _master in the appropriate scope
-- which captures the value of Current_Master. Mark the enclosing body as
-- being a task master. A _master is built to avoid multiple expensive
-- calls to Current_Master and to facilitate object initialization. Flag
-- Use_Current ensures that the master scope is the current scope.
procedure Build_Master_Renaming (N : Node_Id; Typ : Entity_Id);
-- Given an access type Typ and a declaration N of a designated type that
-- is either a task or contains tasks, create a renaming of the form:
--
-- TypM : Master_Id renames _Master;
--
-- where _master denotes the task master of the enclosing context. The
-- renaming declaration is inserted before N.
function Build_Private_Protected_Declaration (N : Node_Id) return Entity_Id;
-- A subprogram body without a previous spec that appears in a protected
......
......@@ -1911,6 +1911,8 @@ package body Lib.Xref is
Op := Ultimate_Alias (Old_E);
-- Normal case of no alias present
-- we omit generated primitives like tagged equality,
-- that have no source representation.
else
Op := Old_E;
......@@ -1918,6 +1920,7 @@ package body Lib.Xref is
if Present (Op)
and then Sloc (Op) /= Standard_Location
and then Comes_From_Source (Op)
then
declare
Loc : constant Source_Ptr := Sloc (Op);
......
......@@ -70,9 +70,6 @@ package body MLib.Prj is
S_Dec_Ads : File_Name_Type := No_File;
-- Name_Id for "dec.ads"
G_Trasym_Ads : File_Name_Type := No_File;
-- Name_Id for "g-trasym.ads"
Arguments : String_List_Access := No_Argument;
-- Used to accumulate arguments for the invocation of gnatbind and of the
-- compiler. Also used to collect the interface ALI when copying the ALI
......@@ -316,9 +313,6 @@ package body MLib.Prj is
Libdecgnat_Needed : Boolean := False;
-- On OpenVMS, set True if library needs to be linked with libdecgnat
Gtrasymobj_Needed : Boolean := False;
-- On OpenVMS, set rue if library needs to be linked with g-trasym.obj
Object_Directory_Path : constant String :=
Get_Name_String
(For_Project.Object_Directory.Display_Name);
......@@ -375,8 +369,7 @@ package body MLib.Prj is
-- to link with -lgnarl (this is the case when there is a dependency
-- on s-osinte.ads). On OpenVMS, set Libdecgnat_Needed if the ALI file
-- indicates that there is a need to link with -ldecgnat (this is the
-- case when there is a dependency on dec.ads). Set Gtrasymobj_Needed
-- if there is a dependency on g-trasym.ads.
-- case when there is a dependency on dec.ads).
procedure Process (The_ALI : File_Name_Type);
-- Check if the closure of a library unit which is or should be in the
......@@ -513,8 +506,7 @@ package body MLib.Prj is
if Libgnarl_Needed /= Yes
or else
(Main_Project
and then OpenVMS_On_Target
and then ((not Libdecgnat_Needed) or (not Gtrasymobj_Needed)))
and then OpenVMS_On_Target)
then
-- Scan the ALI file
......@@ -548,9 +540,6 @@ package body MLib.Prj is
elsif OpenVMS_On_Target then
if ALI.Sdep.Table (Index).Sfile = S_Dec_Ads then
Libdecgnat_Needed := True;
elsif ALI.Sdep.Table (Index).Sfile = G_Trasym_Ads then
Gtrasymobj_Needed := True;
end if;
end if;
end loop;
......@@ -838,12 +827,6 @@ package body MLib.Prj is
S_Dec_Ads := Name_Find;
end if;
if G_Trasym_Ads = No_File then
Name_Len := 0;
Add_Str_To_Name_Buffer ("g-trasym.ads");
G_Trasym_Ads := Name_Find;
end if;
-- We work in the object directory
Change_Dir (Object_Directory_Path);
......@@ -1556,8 +1539,7 @@ package body MLib.Prj is
ALIs.Append (new String'(ALI_Path));
-- Find out if for this ALI file,
-- libgnarl or libdecgnat or
-- g-trasym.obj (on OpenVMS) is
-- libgnarl or libdecgnat is
-- necessary.
Check_Libs (ALI_Path, True);
......@@ -1642,12 +1624,6 @@ package body MLib.Prj is
end if;
end if;
if Gtrasymobj_Needed then
Opts.Increment_Last;
Opts.Table (Opts.Last) :=
new String'(Lib_Directory & "/g-trasym.obj");
end if;
if Libdecgnat_Needed then
Opts.Increment_Last;
......
......@@ -62,34 +62,7 @@ package body Ch2 is
-- Code duplication, see Par_Ch3.P_Defining_Identifier???
if Token = Tok_Identifier then
-- Shouldn't the warnings below be emitted when in Ada 83 mode???
-- Ada 2005 (AI-284): If compiling in Ada 95 mode, we warn that
-- INTERFACE, OVERRIDING, and SYNCHRONIZED are new reserved words.
if Ada_Version = Ada_95
and then Warn_On_Ada_2005_Compatibility
then
if Token_Name = Name_Overriding
or else Token_Name = Name_Synchronized
or else (Token_Name = Name_Interface
and then Prev_Token /= Tok_Pragma)
then
Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node);
end if;
end if;
-- Similarly, warn about Ada 2012 reserved words
if Ada_Version in Ada_95 .. Ada_2005
and then Warn_On_Ada_2012_Compatibility
then
if Token_Name = Name_Some then
Error_Msg_N ("& is a reserved word in Ada 2012?", Token_Node);
end if;
end if;
Check_Future_Keyword;
Ident_Node := Token_Node;
Scan; -- past Identifier
return Ident_Node;
......
......@@ -213,38 +213,7 @@ package body Ch3 is
-- Duplication should be removed, common code should be factored???
if Token = Tok_Identifier then
-- Shouldn't the warnings below be emitted when in Ada 83 mode???
-- Ada 2005 (AI-284): If compiling in Ada 95 mode, we warn that
-- INTERFACE, OVERRIDING, and SYNCHRONIZED are new reserved words.
-- Note that in the case where these keywords are misused in Ada 95
-- mode, this routine will generally not be called at all.
-- What sort of misuse is this comment talking about??? These are
-- perfectly legitimate defining identifiers in Ada 95???
if Ada_Version = Ada_95
and then Warn_On_Ada_2005_Compatibility
then
if Token_Name = Name_Overriding
or else Token_Name = Name_Synchronized
or else (Token_Name = Name_Interface
and then Prev_Token /= Tok_Pragma)
then
Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node);
end if;
end if;
-- Similarly, warn about Ada 2012 reserved words
if Ada_Version in Ada_95 .. Ada_2005
and then Warn_On_Ada_2012_Compatibility
then
if Token_Name = Name_Some then
Error_Msg_N ("& is a reserved word in Ada 2012?", Token_Node);
end if;
end if;
Check_Future_Keyword;
-- If we have a reserved identifier, manufacture an identifier with
-- a corresponding name after posting an appropriate error message
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
......@@ -169,6 +169,43 @@ package body Util is
end Check_Bad_Layout;
--------------------------
-- Check_Future_Keyword --
--------------------------
procedure Check_Future_Keyword is
begin
-- Ada 2005 (AI-284): Compiling in Ada95 mode we warn that INTERFACE,
-- OVERRIDING, and SYNCHRONIZED are new reserved words.
if Ada_Version = Ada_95
and then Warn_On_Ada_2005_Compatibility
then
if Token_Name = Name_Overriding
or else Token_Name = Name_Synchronized
or else (Token_Name = Name_Interface
and then Prev_Token /= Tok_Pragma)
then
Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node);
end if;
end if;
-- Similarly, warn about Ada 2012 reserved words
if Ada_Version in Ada_95 .. Ada_2005
and then Warn_On_Ada_2012_Compatibility
then
if Token_Name = Name_Some then
Error_Msg_N ("& is a reserved word in Ada 2012?", Token_Node);
end if;
end if;
-- Note: we deliberately do not emit these warnings when operating in
-- Ada 83 mode because in that case we assume the user is building
-- legacy code anyway.
end Check_Future_Keyword;
--------------------------
-- Check_Misspelling_Of --
--------------------------
......
......@@ -1156,6 +1156,11 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
-- mode. The caller has typically checked that the current token,
-- an identifier, matches one of the 95 keywords.
procedure Check_Future_Keyword;
-- Emit a warning if the current token is a valid identifier in the
-- language version in use, but is a reserved word in a later language
-- version (unless the language version in use is Ada 83).
procedure Check_Simple_Expression (E : Node_Id);
-- Given an expression E, that has just been scanned, so that Expr_Form
-- is still set, outputs an error if E is a non-simple expression. E is
......
......@@ -1089,9 +1089,7 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_destroy (S.L'Access);
pragma Assert (Result = 0);
if Result = ENOMEM then
raise Storage_Error;
end if;
raise Storage_Error;
end if;
Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access);
......@@ -1101,11 +1099,10 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_destroy (S.L'Access);
pragma Assert (Result = 0);
if Result = ENOMEM then
Result := pthread_condattr_destroy (Cond_Attr'Access);
pragma Assert (Result = 0);
raise Storage_Error;
end if;
Result := pthread_condattr_destroy (Cond_Attr'Access);
pragma Assert (Result = 0);
raise Storage_Error;
end if;
Result := pthread_condattr_destroy (Cond_Attr'Access);
......
......@@ -1502,7 +1502,7 @@ package body System.Tasking.Rendezvous is
-- Null_Body. Defer abort until it gets into the accept body.
Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
Initialization.Defer_Abort (Self_Id);
Initialization.Defer_Abort_Nestable (Self_Id);
STPO.Unlock (Self_Id);
when Accept_Alternative_Completed =>
......
......@@ -706,11 +706,9 @@ package body Sem_Ch3 is
(Related_Nod : Node_Id;
N : Node_Id) return Entity_Id
is
Loc : constant Source_Ptr := Sloc (Related_Nod);
Anon_Type : Entity_Id;
Anon_Scope : Entity_Id;
Desig_Type : Entity_Id;
Decl : Entity_Id;
Enclosing_Prot_Type : Entity_Id := Empty;
begin
......@@ -903,26 +901,8 @@ package body Sem_Ch3 is
and then Comes_From_Source (Related_Nod)
and then not Restriction_Active (No_Task_Hierarchy)
then
if not Has_Master_Entity (Current_Scope) then
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uMaster),
Constant_Present => True,
Object_Definition =>
New_Reference_To (RTE (RE_Master_Id), Loc),
Expression =>
Make_Explicit_Dereference (Loc,
New_Reference_To (RTE (RE_Current_Master), Loc)));
Insert_Before (Related_Nod, Decl);
Analyze (Decl);
Set_Master_Id (Anon_Type, Defining_Identifier (Decl));
Set_Has_Master_Entity (Current_Scope);
else
Build_Master_Renaming (Related_Nod, Anon_Type);
end if;
Build_Master_Entity (Defining_Identifier (Related_Nod), True);
Build_Master_Renaming (Related_Nod, Anon_Type);
end if;
end if;
......
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