diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 20 | ||||
| -rw-r--r-- | gcc/ada/exp_imgv.adb | 28 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-taprop__linux.adb | 29 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 9 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/entry_family.adb | 28 |
7 files changed, 98 insertions, 29 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e309185..44ce6db 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +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. diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index 4f12a8c..0a400ec 100644 --- a/gcc/ada/exp_imgv.adb +++ b/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)); diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb index 0be44ed..77fe26f 100644 --- a/gcc/ada/libgnarl/s-taprop__linux.adb +++ b/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; -------------- diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 58a3ed7..a352f3c 100644 --- a/gcc/ada/sem_ch13.adb +++ b/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 diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 6e83958..ada86c2 100644 --- a/gcc/ada/sem_res.adb +++ b/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. diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 18c4a26..6a25a14 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +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 diff --git a/gcc/testsuite/gnat.dg/entry_family.adb b/gcc/testsuite/gnat.dg/entry_family.adb new file mode 100644 index 0000000..21d208f --- /dev/null +++ b/gcc/testsuite/gnat.dg/entry_family.adb @@ -0,0 +1,28 @@ +-- { 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; |