exp_imgv.adb (Expand_Image_Attribute): Disable the optimized expansion of…

exp_imgv.adb (Expand_Image_Attribute): Disable the optimized expansion of user-defined enumeration types when...

gcc/ada/

2017-09-25  Javier Miranda  <miranda@adacore.com>

	* exp_imgv.adb (Expand_Image_Attribute): Disable the optimized
	expansion of user-defined enumeration types when the generation of
	names for enumeration literals is suppressed.

2017-09-25  Gary Dismukes  <dismukes@adacore.com>

	* libgnarl/s-taprop__linux.adb: Minor reformatting.

2017-09-25  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Resolve_Aspect_Expressions): Do not resolve identifiers
	that appear as selector names of parameter associations, as these are
	never resolved by visibility.

2017-09-25  Justin Squirek  <squirek@adacore.com>

	* sem_res.adb (Resolve_Entry): Generate reference for index entities.

gcc/testsuite/

2017-09-25  Justin Squirek  <squirek@adacore.com>

	* gnat.dg/entry_family.adb: New testcase

From-SVN: r253139

gcc/ada/ChangeLog

+2017-09-25  Javier Miranda  <miranda@adacore.com>
+
+	* exp_imgv.adb (Expand_Image_Attribute): Disable the optimized
+	expansion of user-defined enumeration types when the generation of
+	names for enumeration literals is suppressed.
+
+2017-09-25  Gary Dismukes  <dismukes@adacore.com>
+
+	* libgnarl/s-taprop__linux.adb: Minor reformatting.
+
+2017-09-25  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Resolve_Aspect_Expressions): Do not resolve identifiers
+	that appear as selector names of parameter associations, as these are
+	never resolved by visibility.
+
+2017-09-25  Justin Squirek  <squirek@adacore.com>
+
+	* sem_res.adb (Resolve_Entry): Generate reference for index entities.
+
 2017-09-25  Doug Rupp  <rupp@adacore.com>
 
 	* libgnarl/s-taprop__linux.adb (Compute_Base_Monotonic_Clock): Refine.

gcc/ada/exp_imgv.adb

@@ -174,7 +174,7 @@ package body Exp_Imgv is
    -- Expand_Image_Attribute --
    ----------------------------
 
-   --  For all cases other than user defined enumeration types, the scheme
+   --  For all cases other than user-defined enumeration types, the scheme
    --  is as follows. First we insert the following code:
 
    --    Snn : String (1 .. rt'Width);
@@ -270,10 +270,10 @@ package body Exp_Imgv is
 
       function Is_User_Defined_Enumeration_Type
         (Typ : Entity_Id) return Boolean;
-      --  Return True if Typ is an user-defined enumeration type
+      --  Return True if Typ is a user-defined enumeration type
 
       procedure Expand_User_Defined_Enumeration_Image;
-      --  Expand attribute 'Image in user-defined enumeration types avoiding
+      --  Expand attribute 'Image in user-defined enumeration types, avoiding
       --  string copy.
 
       -------------------------------------------
@@ -314,7 +314,7 @@ package body Exp_Imgv is
                    Prefix         => New_Occurrence_Of (Ptyp, Loc),
                    Expressions    => New_List (Expr)))));
 
-         --  Compute the index of the string start generating:
+         --  Compute the index of the string start, generating:
          --    P2 : constant Natural := call_put_enumN (P1);
 
          Append_To (Ins_List,
@@ -331,7 +331,7 @@ package body Exp_Imgv is
                    Expressions =>
                      New_List (New_Occurrence_Of (P1_Id, Loc))))));
 
-         --  Compute the index of the next value generating:
+         --  Compute the index of the next value, generating:
          --    P3 : constant Natural := call_put_enumN (P1 + 1);
 
          declare
@@ -455,11 +455,13 @@ package body Exp_Imgv is
          Rewrite_Object_Image (N, Pref, Name_Image, Standard_String);
          return;
 
-      --  Enable speed optimized expansion of user-defined enumeration types
-      --  if we are compiling with optimizations enabled. Otherwise the call
-      --  will be expanded into a call to the runtime library.
+      --  Enable speed-optimized expansion of user-defined enumeration types
+      --  if we are compiling with optimizations enabled and enumeration type
+      --  literals are generated. Otherwise the call will be expanded into a
+      --  call to the runtime library.
 
       elsif Optimization_Level > 0
+        and then not Global_Discard_Names
         and then Is_User_Defined_Enumeration_Type (Root_Type (Entity (Pref)))
       then
          Expand_User_Defined_Enumeration_Image;
@@ -561,7 +563,7 @@ package body Exp_Imgv is
          Imid := RE_Image_Floating_Point;
          Tent := Standard_Long_Long_Float;
 
-      --  Only other possibility is user defined enumeration type
+      --  Only other possibility is user-defined enumeration type
 
       else
          if Discard_Names (First_Subtype (Ptyp))
@@ -856,7 +858,7 @@ package body Exp_Imgv is
       elsif Is_Real_Type (Rtyp) then
          Vid := RE_Value_Real;
 
-      --  Only other possibility is user defined enumeration type
+      --  Only other possibility is user-defined enumeration type
 
       else
          pragma Assert (Is_Enumeration_Type (Rtyp));
@@ -929,7 +931,7 @@ package body Exp_Imgv is
          return;
       end if;
 
-      --  Fall through for all cases except user defined enumeration type
+      --  Fall through for all cases except user-defined enumeration type
       --  and decimal types, with Vid set to the Id of the entity for the
       --  Value routine and Args set to the list of parameters for the call.
 
@@ -1246,7 +1248,7 @@ package body Exp_Imgv is
    --  because the base type is always static, and hence the expression
    --  in the else is reduced to an integer literal.
 
-   --  For user defined enumeration types, typ'Width expands into
+   --  For user-defined enumeration types, typ'Width expands into
 
    --    Result_Type (Width_Enumeration_NN
    --                  (typS,
@@ -1371,7 +1373,7 @@ package body Exp_Imgv is
          Analyze_And_Resolve (N, Typ);
          return;
 
-      --  User defined enumeration types
+      --  User-defined enumeration types
 
       else
          pragma Assert (Is_Enumeration_Type (Rtyp));

gcc/ada/libgnarl/s-taprop__linux.adb

@@ -165,10 +165,9 @@ package body System.Task_Primitives.Operations is
    procedure Abort_Handler (signo : Signal);
 
    function Compute_Base_Monotonic_Clock return Duration;
-   --  The monotonic clock epoch is set to some undetermined time
-   --  in the past (typically system boot time).  In order to use the
-   --  monotonic clock for absolute time, the offset from a known epoch
-   --  is needed.
+   --  The monotonic clock epoch is set to some undetermined time in the past
+   --  (typically system boot time). In order to use the monotonic clock for
+   --  absolute time, the offset from a known epoch is needed.
 
    function GNAT_pthread_condattr_setup
      (attr : access pthread_condattr_t) return C.int;
@@ -288,14 +287,14 @@ package body System.Task_Primitives.Operations is
       pragma Assert (Res_A = 0);
 
       for I in 1 .. 10 loop
-         --  Guard against a leap second which will cause CLOCK_REALTIME
-         --  to jump backwards.  In the extrenmely unlikely event we call
-         --  clock_gettime before and after the jump the epoch result will
-         --  be off slightly.
-         --  Use only results where the tv_sec values match for the sake
-         --  of convenience.
-         --  Also try to calculate the most accurate
-         --  epoch by taking the minimum difference of 10 tries.
+         --  Guard against a leap second that will cause CLOCK_REALTIME to jump
+         --  backwards. In the extrenmely unlikely event we call clock_gettime
+         --  before and after the jump the epoch, the result will be off
+         --  slightly.
+         --  Use only results where the tv_sec values match, for the sake of
+         --  convenience.
+         --  Also try to calculate the most accurate epoch by taking the
+         --  minimum difference of 10 tries.
 
          Res_B := clock_gettime
           (clock_id => OSC.CLOCK_REALTIME, tp => TS_Bef'Unchecked_Access);
@@ -309,13 +308,13 @@ package body System.Task_Primitives.Operations is
 
          if (TS_Bef0.tv_sec /= TS_Aft0.tv_sec and then
              TS_Bef.tv_sec  = TS_Aft.tv_sec)
-            --  The calls to clock_gettime before the loop were no good.
+            --  The calls to clock_gettime before the loop were no good
             or else
             (TS_Bef0.tv_sec = TS_Aft0.tv_sec and then
              TS_Bef.tv_sec  = TS_Aft.tv_sec and then
             (TS_Aft.tv_nsec  - TS_Bef.tv_nsec <
              TS_Aft0.tv_nsec - TS_Bef0.tv_nsec))
-            --  The most recent calls to clock_gettime were more better.
+            --  The most recent calls to clock_gettime were better
          then
             TS_Bef0 := TS_Bef;
             TS_Aft0 := TS_Aft;
@@ -328,7 +327,7 @@ package body System.Task_Primitives.Operations is
       Aft := To_Duration (TS_Aft0);
 
       return Bef / 2 + Aft / 2 - Mon;
-      --  Distribute the division to avoid potential type overflow someday.
+      --  Distribute the division, to avoid potential type overflow someday
    end Compute_Base_Monotonic_Clock;
 
    --------------

gcc/ada/sem_ch13.adb

@@ -12797,7 +12797,14 @@ package body Sem_Ch13 is
 
             return Skip;
 
-         elsif Nkind (N) = N_Identifier and then Chars (N) /= Chars (E) then
+         --  Resolve identifiers that are not selectors in parameter
+         --  associations (these are never resolved by visibility).
+
+         elsif Nkind (N) = N_Identifier
+           and then Chars (N) /= Chars (E)
+           and then (Nkind (Parent (N)) /= N_Parameter_Association
+                      or else N /= Selector_Name (Parent (N)))
+         then
             Find_Direct_Name (N);
 
             --  In ASIS mode we must analyze overloaded identifiers to ensure

gcc/ada/sem_res.adb

@@ -7474,6 +7474,15 @@ package body Sem_Res is
          Index := First (Expressions (Entry_Name));
          Resolve (Index, Entry_Index_Type (Nam));
 
+         --  Generate a reference for the index entity when the index is not a
+         --  literal.
+
+         if Nkind (Index) in N_Has_Entity
+           and then Nkind (Entity (Index)) in N_Entity
+         then
+            Generate_Reference (Entity (Index), Nam, ' ');
+         end if;
+
          --  Up to this point the expression could have been the actual in a
          --  simple entry call, and be given by a named association.
 

gcc/testsuite/ChangeLog

+2017-09-25  Justin Squirek  <squirek@adacore.com>
+
+	* gnat.dg/entry_family.adb: New testcase
+
 2017-09-24  H.J. Lu  <hongjiu.lu@intel.com>
 
 	PR target/82267

gcc/testsuite/gnat.dg/entry_family.adb

+--  { dg-do compile }
+--  { dg-options "-gnatwu" }
+
+with Ada.Numerics.Discrete_Random; use Ada.Numerics;
+
+procedure Entry_Family is
+   protected Family is
+      entry Call (Boolean);
+   end Family;
+
+   protected body Family is
+      entry Call (for P in Boolean) when True is
+      begin
+         null;
+      end Call;
+
+   end Family;
+
+   package Random_Boolean is new Discrete_Random (Result_Subtype => Boolean);
+   use Random_Boolean;
+
+   Boolean_Generator : Generator;
+
+   B : constant Boolean := Random (Boolean_Generator);
+
+begin
+   Family.Call (B);
+end Entry_Family;