2014-02-24 Sergey Rybin <rybin@adacore.com frybin>

	* gnat_ugn.texi: Misc updates.

2014-02-24  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_prag.adb (Expand_Old): Set the type of the generated temporary.

2014-02-24  Gary Dismukes  <dismukes@adacore.com>

	* layout.adb (Layout_Variant_Record): Instantiate
	Generic_Check_Choices and call Check_Choices before calling
	Build_Discr_Checking_Funcs, since we need Others_Discrete_Choices
	set to prevent generating incorrect discriminant-checking
	functions for 'others' variants (functions that unconditionally
	return True rather than accounting for the values covered by the
	'others' choice).
	* sem_eval.ads (Subtypes_Statically_Compatible): Add formal
	Formal_Derived_Matching.
	(Subtypes_Statically_Match): Add formal Formal_Derived_Matching.
	* sem_eval.adb (Subtypes_Statically_Compatible): Pass new
	Formal_Derived_Matching formal to Subtypes_Statically_Match.
	(Subtypes_Statically_Match): Suppress the Object_Size matching
	test in the case where Formal_Derived_Matching is True.
	* sem_ch12.adb (Validate_Derived_Type_Instance): Pass
	True for Formal_Derived_Matching_Formal on the call to
	Subtypes_Statically_Compatible.



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

7 files changed, 173 insertions, 19 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 003533801eb..3a936730bea 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,31 @@
+2014-02-24  Sergey Rybin  <rybin@adacore.com frybin>
+
+	* gnat_ugn.texi: Misc updates.
+
+2014-02-24  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_prag.adb (Expand_Old): Set the type of the generated temporary.
+
+2014-02-24  Gary Dismukes  <dismukes@adacore.com>
+
+	* layout.adb (Layout_Variant_Record): Instantiate
+	Generic_Check_Choices and call Check_Choices before calling
+	Build_Discr_Checking_Funcs, since we need Others_Discrete_Choices
+	set to prevent generating incorrect discriminant-checking
+	functions for 'others' variants (functions that unconditionally
+	return True rather than accounting for the values covered by the
+	'others' choice).
+	* sem_eval.ads (Subtypes_Statically_Compatible): Add formal
+	Formal_Derived_Matching.
+	(Subtypes_Statically_Match): Add formal Formal_Derived_Matching.
+	* sem_eval.adb (Subtypes_Statically_Compatible): Pass new
+	Formal_Derived_Matching formal to Subtypes_Statically_Match.
+	(Subtypes_Statically_Match): Suppress the Object_Size matching
+	test in the case where Formal_Derived_Matching is True.
+	* sem_ch12.adb (Validate_Derived_Type_Instance): Pass
+	True for Formal_Derived_Matching_Formal on the call to
+	Subtypes_Statically_Compatible.
+
 2014-02-23  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/Make-lang.in (ADA_TOOLS_FLAGS_TO_PASS): Robustify.
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 54aec71de66..1925012b845 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -436,6 +436,7 @@ package body Exp_Prag is
             then
                Pref := Prefix (N);
                Temp := Make_Temporary (Loc, 'T', Pref);
+               Set_Etype (Temp, Etype (Pref));
 
                --  Generate a temporary to capture the value of the prefix:
                --    Temp : <Pref type>;
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index f8974492aeb..10285e775ad 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -14643,6 +14643,31 @@ Display Copyright and version, then exit disregarding all other options.
 @cindex @option{--help} @command{gnatpp}
 Display usage, then exit disregarding all other options.
 
+@item -P @var{file}
+@cindex @option{-P} @command{gnatpp}
+Indicates the name of the project file that describes the set of sources
+to be processed. The exact set of argument sources depends on other options
+specified, see below.
+
+@item -U
+@cindex @option{-U} @command{gnatpp}
+If a project file is specified and no argument source is explicitly
+specified (either directly or by means of @option{-files} option), process
+all the units of the closure of the argument project. Otherwise this option
+has no effect.
+
+@item -U @var{main_unit}
+If a project file is specified and no argument source is explicitly
+specified (either directly or by means of @option{-files} option), process
+the closure of units rooted at @var{main_unit}. Otherwise this option
+has no effect.
+
+@item -X@var{name}=@var{value}
+@cindex @option{-X} @command{gnatpp}
+Indicates that external variable @var{name} in the argument project
+has the @var{value} value. Has no effect if no project is specified as
+tool argument.
+
 @item --pp-off=@var{xxx}
 @cindex @option{--pp-off} @command{gnatpp}
 Use @code{--xxx} as the command to turn off pretty printing, instead
@@ -14692,6 +14717,13 @@ Warning mode;
 a required layout in the result source.
 @end table
 
+@noindent
+If a project file is specified and no argument source is explicitly
+specified (either directly or by means of @option{-files} option), and no
+@option{-U} is specified, then the set of processed sources is
+all the immediate units of the argument project.
+
+
 @node Formatting Rules
 @section Formatting Rules
 
@@ -15318,6 +15350,23 @@ Options:
 -h
 --help -- generate usage information and quit, ignoring all other options
 
+-P @file{file} -- indicates the name of the project file that describes
+      the set of sources to be processed. The exact set of argument
+      sources depends on other options specified, see below.
+
+-U -- if a project file is specified and no argument source is explicitly
+      specified, process all the units of the closure of the argument project.
+      Otherwise this option has no effect.
+
+-U @var{main_unit} -- if a project file is specified and no argument source
+      is explicitly specified (either directly or by means of @option{-files}
+      option), process the closure of units rooted at @var{main_unit}.
+      Otherwise this option has no effect.
+
+-X@var{name}=@var{value} -- indicates that external variable @var{name} in
+      the argument project has the @var{value} value. Has no effect if no
+      project is specified as tool argument.
+
 -mdir -- generate one .xml file for each Ada source file, in directory
          @file{dir}. (Default is to generate the XML to standard output.)
 
@@ -15340,6 +15389,11 @@ Options:
 @end smallexample
 
 @noindent
+If a project file is specified and no argument source is explicitly
+specified, and no @option{-U} is specified, then the set of processed
+sources is all the immediate units of the argument project.
+
+
 You can generate the ``tree files'' ahead of time using the -gnatct switch:
 
 @smallexample
@@ -16697,7 +16751,14 @@ tool argument.
 Use the specified subdirectory of the project objects file (or of the
 project file directory if the project does not specify an object directory)
 for tool output files. Has no effect if no project is specified as
-tool argument.
+tool argument r if @option{--no_objects_dir} is specified.
+
+@item --no_objects_dir
+@cindex @option{--no_objects_dir} @command{gnatmetric}
+Place all the result files into the current directory instead of
+project objects directory. This corresponds to the @command{gnatcheck}
+behavior when it is called with the project file from the
+GNAT driver. Has no effect if no project is specified.
 
 @item ^-files @var{filename}^/FILES=@var{filename}^
 @cindex @option{^-files^/FILES^} (@code{gnatmetric})
@@ -16729,13 +16790,11 @@ a trace of sources being processed.
 Quiet mode.
 @end table
 
-@ignore
 @noindent
 If a project file is specified and no argument source is explicitly
 specified (either directly or by means of @option{-files} option), and no
 @option{-U} is specified, then the set of processed sources is
 all the immediate units of the argument project.
-@end ignore
 
 
 @ignore
diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb
index ada36de8c75..829d75c2eb9 100644
--- a/gcc/ada/layout.adb
+++ b/gcc/ada/layout.adb
@@ -37,6 +37,7 @@ with Opt;      use Opt;
 with Repinfo;  use Repinfo;
 with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
+with Sem_Case; use Sem_Case;
 with Sem_Ch13; use Sem_Ch13;
 with Sem_Eval; use Sem_Eval;
 with Sem_Util; use Sem_Util;
@@ -2224,9 +2225,54 @@ package body Layout is
             end if;
          end Layout_Component_List;
 
+         Others_Present : Boolean;
+         pragma Warnings (Off, Others_Present);
+         --  Indicates others present, not used in this case
+
+         procedure Non_Static_Choice_Error (Choice : Node_Id);
+         --  Error routine invoked by the generic instantiation below when
+         --  the variant part has a nonstatic choice.
+
+         package Variant_Choices_Processing is new
+           Generic_Check_Choices
+             (Process_Empty_Choice      => No_OP,
+              Process_Non_Static_Choice => Non_Static_Choice_Error,
+              Process_Associated_Node   => No_OP);
+         use Variant_Choices_Processing;
+
+         -----------------------------
+         -- Non_Static_Choice_Error --
+         -----------------------------
+
+         procedure Non_Static_Choice_Error (Choice : Node_Id) is
+         begin
+            Flag_Non_Static_Expr
+              ("choice given in case expression is not static!", Choice);
+         end Non_Static_Choice_Error;
+
       --  Start of processing for Layout_Variant_Record
 
       begin
+         --  Call Check_Choices here to ensure that Others_Discrete_Choices
+         --  gets set on any 'others' choice before the discriminant-checking
+         --  functions are generated. Otherwise the function for the 'others'
+         --  alternative will unconditionally return True, causing discriminant
+         --  checks to fail. However, Check_Choices is now normally delayed
+         --  until the type's freeze entity is processed, due to requirements
+         --  coming from subtype predicates, so doing it at this point is
+         --  probably not right in general, but it's not clear how else to deal
+         --  with this situation. Perhaps we should only generate declarations
+         --  for the checking functions here, and somehow delay generation of
+         --  their bodies, but that would be a nontrivial change. ???
+
+         declare
+            VP : constant Node_Id :=
+                   Variant_Part (Component_List (Type_Definition (Decl)));
+         begin
+            Check_Choices
+              (VP, Variants (VP), Etype (Name (VP)), Others_Present);
+         end;
+
          --  We need the discriminant checking functions, since we generate
          --  calls to these functions for the RM_Size expression, so make
          --  sure that these functions have been constructed in time.
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 54df193ab8b..59fc323b349 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -11124,7 +11124,9 @@ package body Sem_Ch12 is
                Abandon_Instantiation (Actual);
             end if;
 
-            if not Subtypes_Statically_Compatible (Act_T, Ancestor) then
+            if not Subtypes_Statically_Compatible
+                     (Act_T, Ancestor, Formal_Derived_Matching => True)
+            then
                Error_Msg_N
                  ("constraint on actual is incompatible with formal", Actual);
                Abandon_Instantiation (Actual);
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 14b2fa97a3b..e8c85f9a50d 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -4786,8 +4786,9 @@ package body Sem_Eval is
    ------------------------------------
 
    function Subtypes_Statically_Compatible
-     (T1 : Entity_Id;
-      T2 : Entity_Id) return Boolean
+     (T1                      : Entity_Id;
+      T2                      : Entity_Id;
+      Formal_Derived_Matching : Boolean := False) return Boolean
    is
    begin
       --  Scalar types
@@ -4863,7 +4864,7 @@ package body Sem_Eval is
 
       else
          return (Is_Composite_Type (T1) and then not Is_Constrained (T2))
-           or else Subtypes_Statically_Match (T1, T2);
+           or else Subtypes_Statically_Match (T1, T2, Formal_Derived_Matching);
       end if;
    end Subtypes_Statically_Compatible;
 
@@ -4877,19 +4878,28 @@ package body Sem_Eval is
    --  values match (RM 4.9.1(1)).
 
    --  In addition, in GNAT, the object size (Esize) values of the types must
-   --  match if they are set. The use of 'Object_Size can cause this to be
-   --  false even if the types would otherwise match in the RM sense.
-
-   function Subtypes_Statically_Match (T1, T2 : Entity_Id) return Boolean is
+   --  match if they are set (unless checking an actual for a formal derived
+   --  type). The use of 'Object_Size can cause this to be false even if the
+   --  types would otherwise match in the RM sense.
+
+   function Subtypes_Statically_Match
+     (T1                      : Entity_Id;
+      T2                      : Entity_Id;
+      Formal_Derived_Matching : Boolean := False) return Boolean
+   is
    begin
       --  A type always statically matches itself
 
       if T1 = T2 then
          return True;
 
-      --  No match if sizes different (from use of 'Object_Size)
+      --  No match if sizes different (from use of 'Object_Size). This test
+      --  is excluded if Formal_Derived_Matching is True, as the base types
+      --  can be different in that case and typically have different sizes
+      --  (and Esizes can be set when Frontend_Layout_On_Target is True).
 
-      elsif Known_Static_Esize (T1) and then Known_Static_Esize (T2)
+      elsif not Formal_Derived_Matching
+        and then Known_Static_Esize (T1) and then Known_Static_Esize (T2)
         and then Esize (T1) /= Esize (T2)
       then
          return False;
diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads
index 6d5cdc8319f..8bd8761f0da 100644
--- a/gcc/ada/sem_eval.ads
+++ b/gcc/ada/sem_eval.ads
@@ -214,17 +214,25 @@ package Sem_Eval is
    --  static, or because one or the other bound raises CE).
 
    function Subtypes_Statically_Compatible
-     (T1 : Entity_Id;
-      T2 : Entity_Id) return Boolean;
+     (T1                      : Entity_Id;
+      T2                      : Entity_Id;
+      Formal_Derived_Matching : Boolean := False) return Boolean;
    --  Returns true if the subtypes are unconstrained or the constraint on
    --  on T1 is statically compatible with T2 (as defined by 4.9.1(4)).
-   --  Otherwise returns false.
-
-   function Subtypes_Statically_Match (T1, T2 : Entity_Id) return Boolean;
+   --  Otherwise returns false. Formal_Derived_Matching indicates whether
+   --  the type T1 is a generic actual being checked against ancestor T2
+   --  in a formal derived type association.
+
+   function Subtypes_Statically_Match
+     (T1                      : Entity_Id;
+      T2                      : Entity_Id;
+      Formal_Derived_Matching : Boolean := False) return Boolean;
    --  Determine whether two types T1, T2, which have the same base type,
    --  are statically matching subtypes (RM 4.9.1(1-2)). Also includes the
    --  extra GNAT rule that object sizes must match (this can be false for
-   --  types that match in the RM sense because of use of 'Object_Size).
+   --  types that match in the RM sense because of use of 'Object_Size),
+   --  except when testing a generic actual T1 against an ancestor T2 in a
+   --  formal derived type association (indicated by Formal_Derived_Matching).
 
    function Compile_Time_Known_Value (Op : Node_Id) return Boolean;
    --  Returns true if Op is an expression not raising Constraint_Error whose