[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

6 files changed, 178 insertions, 63 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9212252..5d5be94 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/a-coinho-shared.adb b/gcc/ada/a-coinho-shared.adb
index 81732b9..3373dbd 100644
--- a/gcc/ada/a-coinho-shared.adb
+++ b/gcc/ada/a-coinho-shared.adb
@@ -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
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 5084714a..219262d 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -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:
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 7cae0e5..4a98f19 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -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;
 
diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads
index e4a2624..21f9ec5 100644
--- a/gcc/ada/s-os_lib.ads
+++ b/gcc/ada/s-os_lib.ads
@@ -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;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 70b4a36..d125bf2 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -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;