[multiple changes]

2014-06-11  Thomas Quinot  <quinot@adacore.com>

	* freeze.ads: Minor reformatting.
	* checks.adb (Determine_Range): Do not attempt to determine
	the range of a deferred constant whose full view has not been
	seen yet.
	* sem_res.adb (Resolve): Remove undesirable guard against
	resolving expressions from expression functions.

2014-06-11  Robert Dewar  <dewar@adacore.com>

	* debug.adb (Debug_Flag_Dot_1): Set to enable fix for anonymous
	access types.
	* layout.adb (Layout_Type): Make anonymous access types for
	subprogram formal types and return types always thin. For now
	only enabled if -gnatd.1 set.

2014-06-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_Stream_TSS_Definition): Apply legality
	rule for stream attributes of interface types (RM 13.13.2 (38/3)):
	subprogram must be a null procedure.

From-SVN: r211464

gcc/ada/ChangeLog

@@ -1,3 +1,26 @@
+2014-06-11  Thomas Quinot  <quinot@adacore.com>
+
+	* freeze.ads: Minor reformatting.
+	* checks.adb (Determine_Range): Do not attempt to determine
+	the range of a deferred constant whose full view has not been
+	seen yet.
+	* sem_res.adb (Resolve): Remove undesirable guard against
+	resolving expressions from expression functions.
+
+2014-06-11  Robert Dewar  <dewar@adacore.com>
+
+	* debug.adb (Debug_Flag_Dot_1): Set to enable fix for anonymous
+	access types.
+	* layout.adb (Layout_Type): Make anonymous access types for
+	subprogram formal types and return types always thin. For now
+	only enabled if -gnatd.1 set.
+
+2014-06-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Analyze_Stream_TSS_Definition): Apply legality
+	rule for stream attributes of interface types (RM 13.13.2 (38/3)):
+	subprogram must be a null procedure.
+
 2014-06-11  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_prag.adb (Analyze_Input_Item): Allow formal

gcc/ada/checks.adb

@@ -4118,20 +4118,6 @@ package body Checks is
    --  Start of processing for Determine_Range
 
    begin
-      --  For temporary constants internally generated to remove side effects
-      --  we must use the corresponding expression to determine the range of
-      --  the expression.
-
-      if Is_Entity_Name (N)
-        and then Nkind (Parent (Entity (N))) = N_Object_Declaration
-        and then Ekind (Entity (N)) = E_Constant
-        and then Is_Internal_Name (Chars (Entity (N)))
-      then
-         Determine_Range
-           (Expression (Parent (Entity (N))), OK, Lo, Hi, Assume_Valid);
-         return;
-      end if;
-
       --  Prevent junk warnings by initializing range variables
 
       Lo  := No_Uint;
@@ -4139,6 +4125,31 @@ package body Checks is
       Lor := No_Uint;
       Hir := No_Uint;
 
+      --  For temporary constants internally generated to remove side effects
+      --  we must use the corresponding expression to determine the range of
+      --  the expression. But note that the expander can also generate
+      --  constants in other cases, including deferred constants.
+
+      if Is_Entity_Name (N)
+        and then Nkind (Parent (Entity (N))) = N_Object_Declaration
+        and then Ekind (Entity (N)) = E_Constant
+        and then Is_Internal_Name (Chars (Entity (N)))
+      then
+         if Present (Expression (Parent (Entity (N)))) then
+            Determine_Range
+              (Expression (Parent (Entity (N))), OK, Lo, Hi, Assume_Valid);
+
+         elsif Present (Full_View (Entity (N))) then
+            Determine_Range
+              (Expression (Parent (Full_View (Entity (N)))),
+               OK, Lo, Hi, Assume_Valid);
+
+         else
+            OK := False;
+         end if;
+         return;
+      end if;
+
       --  If type is not defined, we can't determine its range
 
       if No (Typ)

gcc/ada/debug.adb

@@ -155,7 +155,7 @@ package body Debug is
    --  d8   Force opposite endianness in packed stuff
    --  d9   Allow lock free implementation
 
-   --  d.1
+   --  d.1  Activate thin-as-default for subprogram anonymous access types
    --  d.2
    --  d.3
    --  d.4
@@ -733,6 +733,15 @@ package body Debug is
    --  d9   This allows lock free implementation for protected objects
    --       (see Exp_Ch9).
 
+   --  d.1  Right now, we have a problem with anonymous access types in the
+   --       context of subprogram formal parameter types and return types. The
+   --       problem occurs when in one place (e.g. the subprogram spec), the
+   --       designated type is unknown (e.g. private) and we choose to use a
+   --       thin pointer representation. Then in another place, we can see the
+   --       full declaration of the type, and choose a fat pointer. The fix is
+   --       to always use thin pointers, but this is causing some other issues,
+   --       so for now, this fix is under control of this debug flag.
+
    ------------------------------------------
    -- Documentation for Binder Debug Flags --
    ------------------------------------------

gcc/ada/freeze.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -195,7 +195,7 @@ package Freeze is
    --  Returns No_List if no freeze nodes needed.
 
    procedure Freeze_All (From : Entity_Id; After : in out Node_Id);
-   --  Before a non-instance body, or at the end of a declarative part
+   --  Before a non-instance body, or at the end of a declarative part,
    --  freeze all entities therein that are not yet frozen. Calls itself
    --  recursively to catch types in inner packages that were not frozen
    --  at the inner level because they were not yet completely defined.

gcc/ada/layout.adb

@@ -1200,8 +1200,7 @@ package body Layout is
 
                   Len := Convert_To (Standard_Unsigned, Len);
 
-                  --  If range definitely flat or superflat,
+                  --  If range definitely flat or superflat, result size is 0
-                  --  result size is zero
 
                   if OK and then LHi <= 0 then
                      Set_Esize (E, Uint_0);
@@ -2432,7 +2431,6 @@ package body Layout is
       --  represents them the same way.
 
       if Is_Access_Type (E) then
-
          Desig_Type :=  Underlying_Type (Designated_Type (E));
 
          --  If we only have a limited view of the type, see whether the
@@ -2464,15 +2462,34 @@ package body Layout is
             Set_Size_Info (E, Base_Type (E));
             Set_RM_Size   (E, RM_Size (Base_Type (E)));
 
+         --  Anonymous access types in subprogram specifications are always
+         --  thin. In the unconstrained case we always use thin pointers for
+         --  anonymous access types, because otherwise we get into strange
+         --  conformance problems between two types, one of which can see
+         --  that something is unconstrained and one of which cannot. The
+         --  object of an extended return is treated similarly.
+
+         elsif Ekind (E) = E_Anonymous_Access_Type
+           and then (Nkind_In (Associated_Node_For_Itype (E),
+                               N_Function_Specification,
+                               N_Procedure_Specification)
+                      or else Ekind (Scope (E))  = E_Return_Statement)
+
+           --  For now, debug flag -gnatd.1 must be set to enable this fix
+
+           and then Debug_Flag_Dot_1
+         then
+            Init_Size (E, System_Address_Size);
+
          --  For other access types, we use either address size, or, if a fat
          --  pointer is used (pointer-to-unconstrained array case), twice the
          --  address size to accommodate a fat pointer.
 
          elsif Present (Desig_Type)
-            and then Is_Array_Type (Desig_Type)
+           and then Is_Array_Type (Desig_Type)
-            and then not Is_Constrained (Desig_Type)
+           and then not Is_Constrained (Desig_Type)
-            and then not Has_Completion_In_Body (Desig_Type)
+           and then not Has_Completion_In_Body (Desig_Type)
-            and then not Debug_Flag_6
+           and then not Debug_Flag_6
          then
             Init_Size (E, 2 * System_Address_Size);
 
@@ -2493,12 +2510,11 @@ package body Layout is
          --  fat pointer.
 
          elsif Present (Desig_Type)
-            and then Present (Parent (Desig_Type))
+           and then Present (Parent (Desig_Type))
-            and then Nkind (Parent (Desig_Type)) = N_Full_Type_Declaration
+           and then Nkind (Parent (Desig_Type)) = N_Full_Type_Declaration
-            and then
+           and then Nkind (Type_Definition (Parent (Desig_Type))) =
-              Nkind (Type_Definition (Parent (Desig_Type)))
+                                             N_Unconstrained_Array_Definition
-                 = N_Unconstrained_Array_Definition
+           and then not Debug_Flag_6
-            and then not Debug_Flag_6
          then
             Init_Size (E, 2 * System_Address_Size);
 
@@ -2519,6 +2535,9 @@ package body Layout is
                        or else Present (Enclosing_Subprogram (E)))))
          then
             Init_Size (E, 2 * System_Address_Size);
+
+         --  Normal case of thin pointer
+
          else
             Init_Size (E, System_Address_Size);
          end if;

gcc/ada/sem_ch13.adb

@@ -3213,6 +3213,21 @@ package body Sem_Ch13 is
             if Is_Abstract_Subprogram (Subp) then
                Error_Msg_N ("stream subprogram must not be abstract", Expr);
                return;
+
+            --  Disable the following for now, until Polyorb issue is fixed.
+
+            elsif Is_Interface (U_Ent)
+              and then not Inside_A_Generic
+              and then Ekind (Subp) = E_Procedure
+              and then
+                not Null_Present
+                  (Specification
+                     (Unit_Declaration_Node (Ultimate_Alias (Subp))))
+              and then False
+            then
+               Error_Msg_N
+                 ("stream subprogram for interface type "
+                  & "must be null procedure", Expr);
             end if;
 
             Set_Entity (Expr, Subp);

gcc/ada/sem_res.adb

@@ -1790,10 +1790,6 @@ package body Sem_Res is
       --  Try and fix up a literal so that it matches its expected type. New
       --  literals are manufactured if necessary to avoid cascaded errors.
 
-      function Proper_Current_Scope return Entity_Id;
-      --  Return the current scope. Skip loop scopes created for the purpose of
-      --  quantified expression analysis since those do not appear in the tree.
-
       procedure Report_Ambiguous_Argument;
       --  Additional diagnostics when an ambiguous call has an ambiguous
       --  argument (typically a controlling actual).
@@ -1856,30 +1852,6 @@ package body Sem_Res is
          end if;
       end Patch_Up_Value;
 
-      --------------------------
-      -- Proper_Current_Scope --
-      --------------------------
-
-      function Proper_Current_Scope return Entity_Id is
-         S : Entity_Id := Current_Scope;
-
-      begin
-         while Present (S) loop
-
-            --  Skip a loop scope created for quantified expression analysis
-
-            if Ekind (S) = E_Loop
-              and then Nkind (Parent (S)) = N_Quantified_Expression
-            then
-               S := Scope (S);
-            else
-               exit;
-            end if;
-         end loop;
-
-         return S;
-      end Proper_Current_Scope;
-
       -------------------------------
       -- Report_Ambiguous_Argument --
       -------------------------------
@@ -2933,15 +2905,12 @@ package body Sem_Res is
          --  default expression mode (the Freeze_Expression routine tests this
          --  flag and only freezes static types if it is set).
 
-         --  Ada 2012 (AI05-177): Expression functions do not freeze. Only
+         --  Ada 2012 (AI05-177): The declaration of an expression function
-         --  their use (in an expanded call) freezes.
+         --  does not cause freezing, but we never reach here in that case.
+         --  Here we are resolving the corresponding expanded body, so we do
+         --  need to perform normal freezing.
 
-         if Ekind (Proper_Current_Scope) /= E_Function
+         Freeze_Expression (N);
-           or else Nkind (Original_Node (Unit_Declaration_Node
-                     (Proper_Current_Scope))) /= N_Expression_Function
-         then
-            Freeze_Expression (N);
-         end if;
 
          --  Now we can do the expansion