2014-01-20 Fedor Rybin <frybin@adacore.com>

	* gnat_ugn.texi: Documenting --passed-tests option for gnattest.

2014-01-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_util.adb (Default_Initialization): New routine.
	* sem_util.ads: Add new type Default_Initialization_Kind.
	(Default_Initialization): New routine.

2014-01-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Check_Mode): Correct all error
	message logic dealing with in/in out parameters that may appear
	as inputs or have a self reference.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@206830 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 211 insertions, 4 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 97defc95cde..82a8ddc320e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+2014-01-20  Fedor Rybin  <frybin@adacore.com>
+
+	* gnat_ugn.texi: Documenting --passed-tests option for gnattest.
+
+2014-01-20  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_util.adb (Default_Initialization): New routine.
+	* sem_util.ads: Add new type Default_Initialization_Kind.
+	(Default_Initialization): New routine.
+
+2014-01-20  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Check_Mode): Correct all error
+	message logic dealing with in/in out parameters that may appear
+	as inputs or have a self reference.
+
 2014-01-20  Robert Dewar  <dewar@adacore.com>
 
 	* exp_ch9.adb, checks.adb, exp_intr.adb: Minor reformatting.
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 6485e9daa82..c17ca38184c 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -19496,6 +19496,12 @@ to check substitutability.
 Specifies the default behavior of generated skeletons. @var{val} can be either
 "fail" or "pass", "fail" being the default.
 
+@item --passed-tests=@var{val}
+@cindex @option{--skeleton-default} (@command{gnattest})
+Specifies whether or not passed tests should be shown. @var{val} can be either
+"show" or "hide", "show" being the default.
+
+
 @item --tests-root=@var{dirname}
 @cindex @option{--tests-root} (@command{gnattest})
 The directory hierarchy of tested sources is recreated in the @var{dirname}
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 54ed0b1430b..ad5e00494e4 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -964,9 +964,12 @@ package body Sem_Prag is
             --  or tags can be read. In general, states and variables are
             --  considered to have mode IN OUT unless they are classified by
             --  pragma [Refined_]Global. In that case, the item must appear in
-            --  an input global list.
+            --  an input global list. OUT parameters of enclosing subprograms
+            --  behave as read-write variables in which case do not emit an
+            --  error.
 
             if (Ekind (Item_Id) = E_Out_Parameter
+                 and then Scope (Item_Id) = Spec_Id
                  and then not Is_Unconstrained_Or_Tagged_Item (Item_Id))
               or else
                 (Global_Seen and then not Appears_In (Subp_Inputs, Item_Id))
@@ -999,18 +1002,34 @@ package body Sem_Prag is
             --  type acts as an input because the discriminants, array bounds
             --  or the tag may be read. Note that the presence of [Refined_]
             --  Global is not significant here because the item is a parameter.
+            --  This rule applies only to the formals of the related subprogram
+            --  as OUT parameters of enclosing subprograms behave as read-write
+            --  variables and their types do not matter.
 
             elsif Ekind (Item_Id) = E_Out_Parameter
+              and then Scope (Item_Id) = Spec_Id
               and then Is_Unconstrained_Or_Tagged_Item (Item_Id)
             then
                null;
 
             --  The remaining cases are IN, IN OUT, and OUT parameters. To
             --  qualify as self-referential item, the parameter must be of
-            --  mode IN OUT.
+            --  mode IN OUT or be an IN OUT or OUT parameter of an enclosing
+            --  subprogram.
 
-            elsif Ekind (Item_Id) /= E_In_Out_Parameter then
-               Error_Msg_NE ("item & must have mode `IN OUT`", Item, Item_Id);
+            elsif Scope (Item_Id) = Spec_Id then
+               if Ekind (Item_Id) /= E_In_Out_Parameter then
+                  Error_Msg_NE
+                    ("item & must have mode `IN OUT`", Item, Item_Id);
+               end if;
+
+            --  Enclosing subprogram parameter
+
+            elsif not Ekind_In (Item_Id, E_In_Out_Parameter,
+                                         E_Out_Parameter)
+            then
+               Error_Msg_NE
+                 ("item & must have mode `IN OUT` or `OUT`", Item, Item_Id);
             end if;
 
          --  Output
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 905eabb89c5..e6468548b73 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -3863,6 +3863,138 @@ package body Sem_Util is
       end if;
    end Deepest_Type_Access_Level;
 
+   ----------------------------
+   -- Default_Initialization --
+   ----------------------------
+
+   function Default_Initialization
+     (Typ : Entity_Id) return Default_Initialization_Kind
+   is
+      Comp : Entity_Id;
+      Init : Default_Initialization_Kind;
+
+      FDI : Boolean := False;
+      NDI : Boolean := False;
+      --  Two flags used to designate whether a record type has at least one
+      --  fully default initialized component and/or one not fully default
+      --  initialized component.
+
+   begin
+      --  Access types are always fully default initialized
+
+      if Is_Access_Type (Typ) then
+         return Full_Default_Initialization;
+
+      --  An array type subject to aspect/pragma Default_Component_Value is
+      --  fully default initialized. Otherwise its initialization status is
+      --  that of its component type.
+
+      elsif Is_Array_Type (Typ) then
+         if Present (Default_Aspect_Component_Value (Base_Type (Typ))) then
+            return Full_Default_Initialization;
+         else
+            return Default_Initialization (Component_Type (Typ));
+         end if;
+
+      --  The initialization status of a private type depends on its full view
+
+      elsif Is_Private_Type (Typ) and then Present (Full_View (Typ)) then
+         return Default_Initialization (Full_View (Typ));
+
+      --  Record and protected types offer several initialization options
+      --  depending on their components (if any).
+
+      elsif Is_Record_Type (Typ) or else Is_Protected_Type (Typ) then
+         Comp := First_Component (Typ);
+
+         --  Inspect all components
+
+         if Present (Comp) then
+            while Present (Comp) loop
+
+               --  Do not process internally generated components except for
+               --  _parent which represents the ancestor portion of a derived
+               --  type.
+
+               if Comes_From_Source (Comp)
+                 or else Chars (Comp) = Name_uParent
+               then
+                  Init := Default_Initialization (Base_Type (Etype (Comp)));
+
+                  --  A component with mixed initialization renders the whole
+                  --  record/protected type mixed.
+
+                  if Init = Mixed_Initialization then
+                     return Mixed_Initialization;
+
+                  --  The component is fully default initialized when its type
+                  --  is fully default initialized or when the component has an
+                  --  initialization expression. Note that this has precedence
+                  --  given that the component type may lack initialization.
+
+                  elsif Init = Full_Default_Initialization
+                    or else Present (Expression (Parent (Comp)))
+                  then
+                     FDI := True;
+
+                  --  Components with no possible initialization are ignored
+
+                  elsif Init = No_Possible_Initialization then
+                     null;
+
+                  --  The component has no full default initialization
+
+                  else
+                     NDI := True;
+                  end if;
+               end if;
+
+               Next_Component (Comp);
+            end loop;
+
+            --  Detect a mixed case of initialization
+
+            if FDI and NDI then
+               return Mixed_Initialization;
+
+            elsif FDI then
+               return Full_Default_Initialization;
+
+            elsif NDI then
+               return No_Default_Initialization;
+
+            --  The type either has no components or they are all internally
+            --  generated.
+
+            else
+               return No_Possible_Initialization;
+            end if;
+
+         --  The record type is null, there is nothing to initialize
+
+         else
+            return No_Possible_Initialization;
+         end if;
+
+      --  A scalar type subject to aspect/pragma Default_Value is fully default
+      --  initialized.
+
+      elsif Is_Scalar_Type (Typ)
+        and then Present (Default_Aspect_Value (Base_Type (Typ)))
+      then
+         return Full_Default_Initialization;
+
+      --  Task types are always fully default initialized
+
+      elsif Is_Task_Type (Typ) then
+         return Full_Default_Initialization;
+      end if;
+
+      --  The type has no full default initialization
+
+      return No_Default_Initialization;
+   end Default_Initialization;
+
    ---------------------
    -- Defining_Entity --
    ---------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 4bd32b495df..8b95413bd3c 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -384,6 +384,40 @@ package Sem_Util is
    --  Current_Scope is returned. The returned value is Empty if this is called
    --  from a library package which is not within any subprogram.
 
+   --  The following type lists all possible forms of default initialization
+   --  that may apply to a type.
+
+   type Default_Initialization_Kind is
+     (No_Possible_Initialization,
+      --  This value signifies that a type cannot possibly be initialized
+      --  because it has no content, for example - a null record.
+
+      Full_Default_Initialization,
+      --  This value covers the following combinations of types and content:
+      --    * Access type
+      --    * Array-of-scalars with specified Default_Component_Value
+      --    * Array type with fully default initialized component type
+      --    * Record or protected type with components that either have a
+      --        default expression or their related types are fully default
+      --        initialized.
+      --    * Scalar type with specified Default_Value
+      --    * Task type
+      --    * Type extension of a type with full default initialization where
+      --        the extension components are also fully default initialized
+
+      Mixed_Initialization,
+      --  This value applies to a type where some of its internals are fully
+      --  default initialized and some are not.
+
+      No_Default_Initialization);
+      --  This value reflects a type where none of its content is fully
+      --  default initialized.
+
+   function Default_Initialization
+     (Typ : Entity_Id) return Default_Initialization_Kind;
+   --  Determine the default initialization kind that applies to a particular
+   --  type.
+
    function Deepest_Type_Access_Level (Typ : Entity_Id) return Uint;
    --  Same as Type_Access_Level, except that if the type is the type of an Ada
    --  2012 stand-alone object of an anonymous access type, then return the