mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-24 08:50:26 +08:00
[multiple changes]
2017-01-13 Javier Miranda <miranda@adacore.com> * sem_ch6.adb (Freeze_Expr_Types): New subprogram. (Analyze_Subprogram_Body_Helper): At the occurrence of an expression function declaration that is a completion, its expression causes freezing (AI12-0103). 2017-01-13 Vadim Godunko <godunko@adacore.com> * a-coinho-shared.adb: Fix memory leaks in Constant_Reference and Reference functions of Ada.Containers.Indefinite_Holders. 2017-01-13 Bob Duff <duff@adacore.com> * s-os_lib.ads: Minor comment fixes. 2017-01-13 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch3.adb (Default_Initialize_Object): Do not default initialize an object when it is of a task type and restriction No_Tasking is in effect because the initialization is obsolete. * exp_ch9.adb (Build_Master_Entity): Do not generate a master when restriction No_Tasking is in effect. (Build_Master_Renaming): Do not rename a master when restriction No_Tasking is in effect. From-SVN: r244418
This commit is contained in:
Arnaud Charlet
parent
b2c1aa8fe9
commit
448a1eb3eb
@ -1,3 +1,29 @@
|
||||
2017-01-13 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* sem_ch6.adb (Freeze_Expr_Types): New subprogram.
|
||||
(Analyze_Subprogram_Body_Helper): At the occurrence of an
|
||||
expression function declaration that is a completion, its
|
||||
expression causes freezing (AI12-0103).
|
||||
|
||||
2017-01-13 Vadim Godunko <godunko@adacore.com>
|
||||
|
||||
* a-coinho-shared.adb: Fix memory leaks in Constant_Reference and
|
||||
Reference functions of Ada.Containers.Indefinite_Holders.
|
||||
|
||||
2017-01-13 Bob Duff <duff@adacore.com>
|
||||
|
||||
* s-os_lib.ads: Minor comment fixes.
|
||||
|
||||
2017-01-13 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* exp_ch3.adb (Default_Initialize_Object): Do not default
|
||||
initialize an object when it is of a task type and restriction
|
||||
No_Tasking is in effect because the initialization is obsolete.
|
||||
* exp_ch9.adb (Build_Master_Entity): Do not generate a master when
|
||||
restriction No_Tasking is in effect.
|
||||
(Build_Master_Renaming): Do not rename a master when restriction
|
||||
No_Tasking is in effect.
|
||||
|
||||
2017-01-13 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_aggr.adb (Resolve_Array_Aggregate): The code that verifies
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2013-2015, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2013-2016, 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- --
|
||||
@ -39,6 +39,10 @@ package body Ada.Containers.Indefinite_Holders is
|
||||
procedure Free is
|
||||
new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
|
||||
|
||||
procedure Detach (Container : Holder);
|
||||
-- Detach data from shared copy if necessary. This is necessary to prepare
|
||||
-- container to be modified.
|
||||
|
||||
---------
|
||||
-- "=" --
|
||||
---------
|
||||
@ -142,21 +146,10 @@ package body Ada.Containers.Indefinite_Holders is
|
||||
begin
|
||||
if Container.Reference = null then
|
||||
raise Constraint_Error with "container is empty";
|
||||
|
||||
elsif Container.Busy = 0
|
||||
and then not System.Atomic_Counters.Is_One
|
||||
(Container.Reference.Counter)
|
||||
then
|
||||
-- Container is not locked and internal shared object is used by
|
||||
-- other container, create copy of both internal shared object and
|
||||
-- element.
|
||||
|
||||
Container'Unrestricted_Access.Reference :=
|
||||
new Shared_Holder'
|
||||
(Counter => <>,
|
||||
Element => new Element_Type'(Container.Reference.Element.all));
|
||||
end if;
|
||||
|
||||
Detach (Container);
|
||||
|
||||
declare
|
||||
Ref : constant Constant_Reference_Type :=
|
||||
(Element => Container.Reference.Element.all'Access,
|
||||
@ -197,6 +190,34 @@ package body Ada.Containers.Indefinite_Holders is
|
||||
end if;
|
||||
end Copy;
|
||||
|
||||
------------
|
||||
-- Detach --
|
||||
------------
|
||||
|
||||
procedure Detach (Container : Holder) is
|
||||
begin
|
||||
if Container.Busy = 0
|
||||
and then not System.Atomic_Counters.Is_One
|
||||
(Container.Reference.Counter)
|
||||
then
|
||||
-- Container is not locked and internal shared object is used by
|
||||
-- other container, create copy of both internal shared object and
|
||||
-- element.
|
||||
|
||||
declare
|
||||
Old : constant Shared_Holder_Access := Container.Reference;
|
||||
|
||||
begin
|
||||
Container'Unrestricted_Access.Reference :=
|
||||
new Shared_Holder'
|
||||
(Counter => <>,
|
||||
Element =>
|
||||
new Element_Type'(Container.Reference.Element.all));
|
||||
Unreference (Old);
|
||||
end;
|
||||
end if;
|
||||
end Detach;
|
||||
|
||||
-------------
|
||||
-- Element --
|
||||
-------------
|
||||
@ -281,21 +302,10 @@ package body Ada.Containers.Indefinite_Holders is
|
||||
begin
|
||||
if Container.Reference = null then
|
||||
raise Constraint_Error with "container is empty";
|
||||
|
||||
elsif Container.Busy = 0
|
||||
and then
|
||||
not System.Atomic_Counters.Is_One (Container.Reference.Counter)
|
||||
then
|
||||
-- Container is not locked and internal shared object is used by
|
||||
-- other container, create copy of both internal shared object and
|
||||
-- element.
|
||||
|
||||
Container'Unrestricted_Access.Reference :=
|
||||
new Shared_Holder'
|
||||
(Counter => <>,
|
||||
Element => new Element_Type'(Container.Reference.Element.all));
|
||||
end if;
|
||||
|
||||
Detach (Container);
|
||||
|
||||
B := B + 1;
|
||||
|
||||
begin
|
||||
@ -359,21 +369,10 @@ package body Ada.Containers.Indefinite_Holders is
|
||||
begin
|
||||
if Container.Reference = null then
|
||||
raise Constraint_Error with "container is empty";
|
||||
|
||||
elsif Container.Busy = 0
|
||||
and then
|
||||
not System.Atomic_Counters.Is_One (Container.Reference.Counter)
|
||||
then
|
||||
-- Container is not locked and internal shared object is used by
|
||||
-- other container, create copy of both internal shared object and
|
||||
-- element.
|
||||
|
||||
Container.Reference :=
|
||||
new Shared_Holder'
|
||||
(Counter => <>,
|
||||
Element => new Element_Type'(Container.Reference.Element.all));
|
||||
end if;
|
||||
|
||||
Detach (Container);
|
||||
|
||||
declare
|
||||
Ref : constant Reference_Type :=
|
||||
(Element => Container.Reference.Element.all'Access,
|
||||
@ -477,21 +476,10 @@ package body Ada.Containers.Indefinite_Holders is
|
||||
begin
|
||||
if Container.Reference = null then
|
||||
raise Constraint_Error with "container is empty";
|
||||
|
||||
elsif Container.Busy = 0
|
||||
and then
|
||||
not System.Atomic_Counters.Is_One (Container.Reference.Counter)
|
||||
then
|
||||
-- Container is not locked and internal shared object is used by
|
||||
-- other container, create copy of both internal shared object and
|
||||
-- element.
|
||||
|
||||
Container'Unrestricted_Access.Reference :=
|
||||
new Shared_Holder'
|
||||
(Counter => <>,
|
||||
Element => new Element_Type'(Container.Reference.Element.all));
|
||||
end if;
|
||||
|
||||
Detach (Container);
|
||||
|
||||
B := B + 1;
|
||||
|
||||
begin
|
||||
|
||||
@ -5654,6 +5654,15 @@ package body Exp_Ch3 is
|
||||
|
||||
if Is_Imported (Def_Id) or else Suppress_Initialization (Def_Id) then
|
||||
return;
|
||||
|
||||
-- Nothing to do if the object being initializes is of a task type
|
||||
-- and restriction No_Tasking is in effect because this is a direct
|
||||
-- violation of the restriction.
|
||||
|
||||
elsif Is_Task_Type (Base_Typ)
|
||||
and then Restriction_Active (No_Tasking)
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- The expansion performed by this routine is as follows:
|
||||
|
||||
@ -3349,10 +3349,14 @@ package body Exp_Ch9 is
|
||||
Find_Enclosing_Context (Par, Context, Context_Id, Decls);
|
||||
end if;
|
||||
|
||||
-- Do not create a master if one already exists or there is no task
|
||||
-- hierarchy.
|
||||
-- Nothing to do if the context already has a master
|
||||
|
||||
if Has_Master_Entity (Context_Id)
|
||||
if Has_Master_Entity (Context_Id) then
|
||||
return;
|
||||
|
||||
-- Nothing to do if tasks or tasking hierarchies are prohibited
|
||||
|
||||
elsif Restriction_Active (No_Tasking)
|
||||
or else Restriction_Active (No_Task_Hierarchy)
|
||||
then
|
||||
return;
|
||||
@ -3425,9 +3429,11 @@ package body Exp_Ch9 is
|
||||
Master_Id : Entity_Id;
|
||||
|
||||
begin
|
||||
-- Nothing to do if there is no task hierarchy
|
||||
-- Nothing to do if tasks or tasking hierarchies are prohibited
|
||||
|
||||
if Restriction_Active (No_Task_Hierarchy) then
|
||||
if Restriction_Active (No_Tasking)
|
||||
or else Restriction_Active (No_Task_Hierarchy)
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
||||
@ -375,7 +375,7 @@ package System.OS_Lib is
|
||||
function File_Time_Stamp (Name : String) return OS_Time;
|
||||
-- Given the name of a file or directory, Name, obtains and returns the
|
||||
-- time stamp. This function can be used for an unopened file. Returns
|
||||
-- Invalid_Time is Name doesn't correspond to an existing file.
|
||||
-- Invalid_Time if Name doesn't correspond to an existing file.
|
||||
|
||||
function File_Time_Stamp (FD : File_Descriptor) return OS_Time;
|
||||
-- Get time stamp of file from file descriptor FD Returns Invalid_Time is
|
||||
@ -662,8 +662,6 @@ package System.OS_Lib is
|
||||
-- This subtype is used to document that a parameter is the address of a
|
||||
-- null-terminated string containing the name of a file.
|
||||
|
||||
-- All the following functions need comments ???
|
||||
|
||||
procedure Copy_File
|
||||
(Name : C_File_Name;
|
||||
Pathname : C_File_Name;
|
||||
@ -687,7 +685,6 @@ package System.OS_Lib is
|
||||
procedure Delete_File (Name : C_File_Name; Success : out Boolean);
|
||||
|
||||
function File_Time_Stamp (Name : C_File_Name) return OS_Time;
|
||||
-- Returns Invalid_Time is Name doesn't correspond to an existing file
|
||||
|
||||
function Is_Directory (Name : C_File_Name) return Boolean;
|
||||
function Is_Executable_File (Name : C_File_Name) return Boolean;
|
||||
|
||||
@ -632,7 +632,7 @@ package body Sem_Ch6 is
|
||||
-- Function result subtype
|
||||
|
||||
procedure Check_Aggregate_Accessibility (Aggr : Node_Id);
|
||||
-- Apply legality rule of 6.5 (8.2) to the access discriminants of an
|
||||
-- Apply legality rule of 6.5 (5.8) to the access discriminants of an
|
||||
-- aggregate in a return statement.
|
||||
|
||||
procedure Check_Return_Subtype_Indication (Obj_Decl : Node_Id);
|
||||
@ -2225,6 +2225,11 @@ package body Sem_Ch6 is
|
||||
-- limited views with the non-limited ones. Return the list of changes
|
||||
-- to be used to undo the transformation.
|
||||
|
||||
procedure Freeze_Expr_Types (Spec_Id : Entity_Id);
|
||||
-- (AI12-0103) N is the body associated with an expression function that
|
||||
-- is a completion, and Spec_Id its defining entity. Freeze before N all
|
||||
-- the types referenced by the expression of the function.
|
||||
|
||||
function Is_Private_Concurrent_Primitive
|
||||
(Subp_Id : Entity_Id) return Boolean;
|
||||
-- Determine whether subprogram Subp_Id is a primitive of a concurrent
|
||||
@ -2945,6 +2950,81 @@ package body Sem_Ch6 is
|
||||
return Result;
|
||||
end Exchange_Limited_Views;
|
||||
|
||||
-----------------------
|
||||
-- Freeze_Expr_Types --
|
||||
-----------------------
|
||||
|
||||
procedure Freeze_Expr_Types (Spec_Id : Entity_Id) is
|
||||
function Freeze_Type_Refs (Node : Node_Id) return Traverse_Result;
|
||||
-- Freeze all types referenced in the subtree rooted at Node
|
||||
|
||||
----------------------
|
||||
-- Freeze_Type_Refs --
|
||||
----------------------
|
||||
|
||||
function Freeze_Type_Refs (Node : Node_Id) return Traverse_Result is
|
||||
begin
|
||||
if Nkind (Node) = N_Identifier
|
||||
and then Present (Entity (Node))
|
||||
then
|
||||
if Is_Type (Entity (Node)) then
|
||||
Freeze_Before (N, Entity (Node));
|
||||
|
||||
elsif Ekind_In (Entity (Node), E_Component,
|
||||
E_Discriminant)
|
||||
then
|
||||
Freeze_Before (N, Scope (Entity (Node)));
|
||||
end if;
|
||||
end if;
|
||||
|
||||
return OK;
|
||||
end Freeze_Type_Refs;
|
||||
|
||||
procedure Freeze_References is new Traverse_Proc (Freeze_Type_Refs);
|
||||
|
||||
-- Local variables
|
||||
|
||||
Return_Stmt : constant Node_Id :=
|
||||
First (Statements (Handled_Statement_Sequence (N)));
|
||||
Dup_Expr : constant Node_Id :=
|
||||
New_Copy_Tree (Expression (Return_Stmt));
|
||||
|
||||
Saved_First_Entity : constant Entity_Id := First_Entity (Spec_Id);
|
||||
Saved_Last_Entity : constant Entity_Id := Last_Entity (Spec_Id);
|
||||
|
||||
-- Start of processing for Freeze_Expr_Types
|
||||
|
||||
begin
|
||||
pragma Assert (Nkind (Return_Stmt) = N_Simple_Return_Statement);
|
||||
|
||||
-- Preanalyze a duplicate of the expression to have available the
|
||||
-- minimum decoration needed to locate referenced unfrozen types
|
||||
-- without adding any decoration to the function expression. This
|
||||
-- preanalysis is performed with errors disabled to avoid reporting
|
||||
-- spurious errors on Ghost entities (since the expression is not
|
||||
-- fully analyzed).
|
||||
|
||||
Push_Scope (Spec_Id);
|
||||
Install_Formals (Spec_Id);
|
||||
Ignore_Errors_Enable := Ignore_Errors_Enable + 1;
|
||||
|
||||
Preanalyze_Spec_Expression (Dup_Expr, Etype (Spec_Id));
|
||||
|
||||
Ignore_Errors_Enable := Ignore_Errors_Enable - 1;
|
||||
End_Scope;
|
||||
|
||||
-- Restore certain attributes of Spec_Id since the preanalysis may
|
||||
-- have introduced itypes to this scope, thus modifying attributes
|
||||
-- First_Entity and Last_Entity.
|
||||
|
||||
Set_First_Entity (Spec_Id, Saved_First_Entity);
|
||||
Set_Last_Entity (Spec_Id, Saved_Last_Entity);
|
||||
|
||||
-- Freeze all types referenced in the expression
|
||||
|
||||
Freeze_References (Dup_Expr);
|
||||
end Freeze_Expr_Types;
|
||||
|
||||
-------------------------------------
|
||||
-- Is_Private_Concurrent_Primitive --
|
||||
-------------------------------------
|
||||
@ -3398,6 +3478,15 @@ package body Sem_Ch6 is
|
||||
then
|
||||
Set_Has_Delayed_Freeze (Spec_Id);
|
||||
Freeze_Before (N, Spec_Id);
|
||||
|
||||
-- At the occurrence of an expression function declaration that is
|
||||
-- a completion, its expression causes freezing (AI12-0103).
|
||||
|
||||
if Has_Completion (Spec_Id)
|
||||
and then Was_Expression_Function (N)
|
||||
then
|
||||
Freeze_Expr_Types (Spec_Id);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user