[multiple changes]

2017-04-27  Yannick Moy  <moy@adacore.com>

	* exp_unst.ads: Fix typos in comments.

2017-04-27  Ed Schonberg  <schonberg@adacore.com>

	* sem_eval.adb (Choice_Matches): Handle properly a real literal
	whose type has a defined static predicate.

2017-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Insert_Dereference_Action):
	Do not adjust the address of a controlled object when the
	associated access type is subject to pragma No_Heap_Finalization.
	Code reformatting.

From-SVN: r247304

gcc/ada/ChangeLog

+2017-04-27  Yannick Moy  <moy@adacore.com>
+
+	* exp_unst.ads: Fix typos in comments.
+
+2017-04-27  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_eval.adb (Choice_Matches): Handle properly a real literal
+	whose type has a defined static predicate.
+
+2017-04-27  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch4.adb (Insert_Dereference_Action):
+	Do not adjust the address of a controlled object when the
+	associated access type is subject to pragma No_Heap_Finalization.
+	Code reformatting.
+
 2017-04-27  Pierre-Marie de Rodat  <derodat@adacore.com>
 
 	* gcc-interface/utils.c (gnat_type_for_size): Set

gcc/ada/exp_ch4.adb

@@ -12032,7 +12032,6 @@ package body Exp_Ch4 is
    -------------------------------
 
    procedure Insert_Dereference_Action (N : Node_Id) is
-
       function Is_Checked_Storage_Pool (P : Entity_Id) return Boolean;
       --  Return true if type of P is derived from Checked_Pool;
 
@@ -12062,11 +12061,12 @@ package body Exp_Ch4 is
 
       --  Local variables
 
-      Typ   : constant Entity_Id  := Etype (N);
-      Desig : constant Entity_Id  := Available_View (Designated_Type (Typ));
+      Context   : constant Node_Id    := Parent (N);
+      Ptr_Typ   : constant Entity_Id  := Etype (N);
+      Desig_Typ : constant Entity_Id  :=
+                    Available_View (Designated_Type (Ptr_Typ));
       Loc       : constant Source_Ptr := Sloc (N);
-      Pool  : constant Entity_Id  := Associated_Storage_Pool (Typ);
-      Pnod  : constant Node_Id    := Parent (N);
+      Pool      : constant Entity_Id  := Associated_Storage_Pool (Ptr_Typ);
 
       Addr      : Entity_Id;
       Alig      : Entity_Id;
@@ -12078,18 +12078,18 @@ package body Exp_Ch4 is
    --  Start of processing for Insert_Dereference_Action
 
    begin
-      pragma Assert (Nkind (Pnod) = N_Explicit_Dereference);
+      pragma Assert (Nkind (Context) = N_Explicit_Dereference);
 
       --  Do not re-expand a dereference which has already been processed by
       --  this routine.
 
-      if Has_Dereference_Action (Pnod) then
+      if Has_Dereference_Action (Context) then
          return;
 
       --  Do not perform this type of expansion for internally-generated
       --  dereferences.
 
-      elsif not Comes_From_Source (Original_Node (Pnod)) then
+      elsif not Comes_From_Source (Original_Node (Context)) then
          return;
 
       --  A dereference action is only applicable to objects which have been
@@ -12131,15 +12131,15 @@ package body Exp_Ch4 is
 
       --  Special case of an unconstrained array: need to add descriptor size
 
-      if Is_Array_Type (Desig)
-        and then not Is_Constrained (First_Subtype (Desig))
+      if Is_Array_Type (Desig_Typ)
+        and then not Is_Constrained (First_Subtype (Desig_Typ))
       then
          Size_Bits :=
            Make_Op_Add (Loc,
              Left_Opnd  =>
                Make_Attribute_Reference (Loc,
                  Prefix         =>
-                   New_Occurrence_Of (First_Subtype (Desig), Loc),
+                   New_Occurrence_Of (First_Subtype (Desig_Typ), Loc),
                  Attribute_Name => Name_Descriptor_Size),
              Right_Opnd => Size_Bits);
       end if;
@@ -12181,7 +12181,14 @@ package body Exp_Ch4 is
       --  knowledge of hidden pointers, we have to bring the two pointers back
       --  in view in order to restore the original state of the object.
 
-      if Needs_Finalization (Desig) then
+      --  The address manipulation is not performed for access types that are
+      --  subject to pragma No_Heap_Finalization because the two pointers do
+      --  not exist in the first place.
+
+      if No_Heap_Finalization (Ptr_Typ) then
+         null;
+
+      elsif Needs_Finalization (Desig_Typ) then
 
          --  Adjust the address and size of the dereferenced object. Generate:
          --    Adjust_Controlled_Dereference (Addr, Size, Alig);
@@ -12203,7 +12210,7 @@ package body Exp_Ch4 is
          --       <Stmt>;
          --    end if;
 
-         if Is_Class_Wide_Type (Desig) then
+         if Is_Class_Wide_Type (Desig_Typ) then
             Deref :=
               Make_Explicit_Dereference (Loc,
                 Prefix => Duplicate_Subexpr_Move_Checks (N));
@@ -12242,7 +12249,7 @@ package body Exp_Ch4 is
       --  Mark the explicit dereference as processed to avoid potential
       --  infinite expansion.
 
-      Set_Has_Dereference_Action (Pnod);
+      Set_Has_Dereference_Action (Context);
 
    exception
       when RE_Not_Available =>

gcc/ada/exp_unst.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2014-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 2014-2017, 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- --
@@ -294,13 +294,13 @@ package Exp_Unst is
 
    --    What we do is to always generate a local constant for any dynamic
    --    bound in a dynamic subtype xx with name xx_FIRST or xx_LAST. The one
-   --    case where we can skip this is where the bound is e.g. in the third
-   --    example above, subtype dynam is expanded as
+   --    case where we can skip this is where the bound is already a constant.
+   --    E.g. in the third example above, subtype dynam is expanded as
 
    --      dynam_LAST : constant Integer := y + 3;
    --      subtype dynam is integer range x .. dynam_LAST;
 
-   --    Now if type dynam is uplevel referenced (as it is this case), then
+   --    Now if type dynam is uplevel referenced (as it is in this case), then
    --    the bounds x and dynam_LAST are marked as uplevel references
    --    so that appropriate entries are made in the activation record. Any
    --    explicit reference to such a bound in the front end generated code
@@ -310,7 +310,7 @@ package Exp_Unst is
    --    these bounds can be replaced by an appropriate reference to the entry
    --    in the activation record for xx_FIRST or xx_LAST. Thus the back end
    --    can eliminate the problematical uplevel reference without the need to
-   --    do the heavy tree modification to do that at the code expansion level
+   --    do the heavy tree modification to do that at the code expansion level.
 
    --  Looking at case 3 again, here is the normal -gnatG expanded code
 
@@ -347,7 +347,7 @@ package Exp_Unst is
    --  we ignore that detail to clarify the examples.
 
    --  Here we see that some of the bounds references are expanded by the
-   --  front end, so that we get explicit references to y or dynamLast. These
+   --  front end, so that we get explicit references to y or dynam_Last. These
    --  cases are handled by the normal uplevel reference mechanism described
    --  above for case 2. This is the case for the constraint check for the
    --  initialization of xx, and the range check in function inner.

gcc/ada/sem_eval.adb

@@ -626,7 +626,8 @@ package body Sem_Eval is
          return Non_Static;
 
       --  When the choice denotes a subtype with a static predictate, check the
-      --  expression against the predicate values.
+      --  expression against the predicate values. Different procedures apply
+      --  to discrete and non-discrete types.
 
       elsif (Nkind (Choice) = N_Subtype_Indication
                or else (Is_Entity_Name (Choice)
@@ -634,10 +635,20 @@ package body Sem_Eval is
         and then Has_Predicates (Etype (Choice))
         and then Has_Static_Predicate (Etype (Choice))
       then
-         return
-           Choices_Match (Expr, Static_Discrete_Predicate (Etype (Choice)));
+         if Is_Discrete_Type (Etype (Choice)) then
+            return Choices_Match
+              (Expr, Static_Discrete_Predicate (Etype (Choice)));
+
+         elsif
+            Real_Or_String_Static_Predicate_Matches (Expr, Etype (Choice))
+         then
+            return Match;
+
+         else
+            return No_Match;
+         end if;
 
-      --  Discrete type case
+      --  Discrete type case only
 
       elsif Is_Discrete_Type (Etyp) then
          Val := Expr_Value (Expr);