From b54d1d39d30c22dd0937b8115e2326637b3558c9 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 20 Oct 2015 13:45:37 +0200 Subject: [PATCH] [multiple changes] 2015-10-20 Bob Duff * a-cobove.adb (Set_Length): Restore previous logic, but with "Checks and then" on the check. 2015-10-20 Ed Schonberg * par-ch3.adb (P_Known_Discriminant_Part_Opt): Handle properly a misplaced "constant" keyword in a discriminant specification. 2015-10-20 Steve Baird * einfo.ads (Is_Param_Block_Component_Type): New function decl for querying the flag. (Set_Is_Param_Block_Component_Type): New procedure decl for setting the flag. * einfo.adb (Is_Param_Block_Component_Type): New function body. (Set_Is_Param_Block_Component_Type): New procedure body. (Write_Entity_Flags): Display the new flag. * exp_ch9.adb (Build_Parameter_Block): Set flag on parameter block component types. (Expand_N_Entry_Declaration): Set flag on parameter block component types. 2015-10-20 Steve Baird * sem_elab.adb: Do not pass an N_Attribute_Reference node to Sinfo.Set_No_Elaboration_Check. * sem_elab.adb (Check_Elab_Call) Do not pass a non-call node (specifically, an N_Attribute_Reference node) to Sinfo.Set_No_Elaboration_Check. 2015-10-20 Tristan Gingold * adaint.c: File names are case sensitive on aarch64-ios. From-SVN: r229051 --- gcc/ada/ChangeLog | 36 ++++++++++++++++++++++++++++++++++++ gcc/ada/a-cobove.adb | 8 +++----- gcc/ada/adaint.c | 3 ++- gcc/ada/einfo.adb | 14 ++++++++++++++ gcc/ada/einfo.ads | 15 ++++++++++++--- gcc/ada/exp_ch9.adb | 2 ++ gcc/ada/par-ch3.adb | 17 ++++++++++++++++- gcc/ada/sem_elab.adb | 4 +++- 8 files changed, 88 insertions(+), 11 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 63ad65539b6..fd2f4f600df 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,39 @@ +2015-10-20 Bob Duff + + * a-cobove.adb (Set_Length): Restore previous logic, but with "Checks + and then" on the check. + +2015-10-20 Ed Schonberg + + * par-ch3.adb (P_Known_Discriminant_Part_Opt): Handle properly + a misplaced "constant" keyword in a discriminant specification. + +2015-10-20 Steve Baird + + * einfo.ads (Is_Param_Block_Component_Type): New function decl + for querying the flag. + (Set_Is_Param_Block_Component_Type): New procedure decl for setting + the flag. + * einfo.adb (Is_Param_Block_Component_Type): New function body. + (Set_Is_Param_Block_Component_Type): New procedure body. + (Write_Entity_Flags): Display the new flag. + * exp_ch9.adb (Build_Parameter_Block): Set flag on parameter + block component types. + (Expand_N_Entry_Declaration): Set flag on parameter block component + types. + +2015-10-20 Steve Baird + + * sem_elab.adb: Do not pass an N_Attribute_Reference node to + Sinfo.Set_No_Elaboration_Check. + * sem_elab.adb (Check_Elab_Call) Do not pass a non-call + node (specifically, an N_Attribute_Reference node) to + Sinfo.Set_No_Elaboration_Check. + +2015-10-20 Tristan Gingold + + * adaint.c: File names are case sensitive on aarch64-ios. + 2015-10-20 Bob Duff * a-cbdlli.ads, a-cbhase.ads, a-cbmutr.ads, a-cborse.ads, diff --git a/gcc/ada/a-cobove.adb b/gcc/ada/a-cobove.adb index 4db39237e6c..4fa7ce8828d 100644 --- a/gcc/ada/a-cobove.adb +++ b/gcc/ada/a-cobove.adb @@ -2411,13 +2411,11 @@ package body Ada.Containers.Bounded_Vectors is if Count >= 0 then Container.Delete_Last (Count); - end if; - - if Checks and then Container.Last >= Index_Type'Last then + elsif Checks and then Container.Last >= Index_Type'Last then raise Constraint_Error with "vector is already at its maximum length"; + else + Container.Insert_Space (Container.Last + 1, -Count); end if; - - Container.Insert_Space (Container.Last + 1, -Count); end Set_Length; ---------- diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 813d2c1f7d6..6849cd1c16c 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -552,7 +552,8 @@ __gnat_get_file_names_case_sensitive (void) { /* By default, we suppose filesystems aren't case sensitive on Windows and Darwin (but they are on arm-darwin). */ -#if defined (WINNT) || (defined (__APPLE__) && !defined (__arm__)) +#if defined (WINNT) \ + || (defined (__APPLE__) && !(defined (__arm__) || defined (__arm64__))) file_names_case_sensitive_cache = 0; #else file_names_case_sensitive_cache = 1; diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 5adc28f3652..c6a999893a8 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -516,6 +516,7 @@ package body Einfo is -- Has_Pragma_Unreferenced_Objects Flag212 -- Requires_Overriding Flag213 -- Has_RACW Flag214 + -- Is_Param_Block_Component_Type Flag215 -- Universal_Aliasing Flag216 -- Suppress_Value_Tracking_On_Call Flag217 -- Is_Primitive Flag218 @@ -2317,6 +2318,12 @@ package body Einfo is return Flag138 (Id); end Is_Packed_Array_Impl_Type; + function Is_Param_Block_Component_Type (Id : E) return B is + begin + pragma Assert (Is_Access_Type (Id)); + return Flag215 (Base_Type (Id)); + end Is_Param_Block_Component_Type; + function Is_Potentially_Use_Visible (Id : E) return B is begin pragma Assert (Nkind (Id) in N_Entity); @@ -5281,6 +5288,12 @@ package body Einfo is Set_Flag138 (Id, V); end Set_Is_Packed_Array_Impl_Type; + procedure Set_Is_Param_Block_Component_Type (Id : E; V : B := True) is + begin + pragma Assert (Ekind_In (Id, E_Void, E_General_Access_Type)); + Set_Flag215 (Id, V); + end Set_Is_Param_Block_Component_Type; + procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True) is begin pragma Assert (Nkind (Id) in N_Entity); @@ -8851,6 +8864,7 @@ package body Einfo is W ("Is_Package_Body_Entity", Flag160 (Id)); W ("Is_Packed", Flag51 (Id)); W ("Is_Packed_Array_Impl_Type", Flag138 (Id)); + W ("Is_Param_Block_Component_Type", Flag215 (Id)); W ("Is_Potentially_Use_Visible", Flag9 (Id)); W ("Is_Predicate_Function", Flag255 (Id)); W ("Is_Predicate_Function_M", Flag256 (Id)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index d32f01dd7a7..f536615d733 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2270,8 +2270,7 @@ package Einfo is -- parent, we do not consider them to be separate units for this flag). -- Is_Completely_Hidden (Flag103) --- Defined in all entities. This flag can be set only for E_Discriminant --- entities. This flag can be set only for girder discriminants of +-- Defined on discriminants. Only set on girder discriminants of -- untagged types. When set, the entity is a girder discriminant of a -- derived untagged type which is not directly visible in the derived -- type because the derived type or one of its ancestors have renamed the @@ -2848,6 +2847,11 @@ package Einfo is -- set in an entity, then the Original_Array_Type field of this entity -- points to the array type for which this is the Packed_Array_Impl_Type. +-- Is_Param_Block_Component_Type (Flag215) [base type only] +-- Defined in access types. Set to indicate that a type is the type of a +-- component of the parameter block record type generated by the compiler +-- for an entry or a select statement. Read by CodePeer. + -- Is_Potentially_Use_Visible (Flag9) -- Defined in all entities. Set if entity is potentially use visible, -- i.e. it is defined in a package that appears in a currently active @@ -5300,7 +5304,6 @@ package Einfo is -- Is_Checked_Ghost_Entity (Flag277) -- Is_Child_Unit (Flag73) -- Is_Compilation_Unit (Flag149) - -- Is_Completely_Hidden (Flag103) -- Is_Descendent_Of_Address (Flag223) -- Is_Discrim_SO_Function (Flag176) -- Is_Discriminant_Check_Function (Flag264) @@ -5526,6 +5529,7 @@ package Einfo is -- Is_Pure_Unit_Access_Type (Flag189) -- No_Pool_Assigned (Flag131) (base type only) -- No_Strict_Aliasing (Flag136) (base type only) + -- Is_Param_Block_Component_Type (Flag215) (base type only) -- (plus type attributes) -- E_Access_Attribute_Type @@ -5706,6 +5710,7 @@ package Einfo is -- Discriminant_Default_Value (Node20) -- Original_Record_Component (Node22) -- CR_Discriminant (Node23) + -- Is_Completely_Hidden (Flag103) -- Is_Return_Object (Flag209) -- Next_Component_Or_Discriminant (synth) -- Next_Discriminant (synth) @@ -6927,6 +6932,7 @@ package Einfo is function Is_Packed (Id : E) return B; function Is_Packed_Array_Impl_Type (Id : E) return B; function Is_Potentially_Use_Visible (Id : E) return B; + function Is_Param_Block_Component_Type (Id : E) return B; function Is_Predicate_Function (Id : E) return B; function Is_Predicate_Function_M (Id : E) return B; function Is_Preelaborated (Id : E) return B; @@ -7587,6 +7593,7 @@ package Einfo is procedure Set_Is_Package_Body_Entity (Id : E; V : B := True); procedure Set_Is_Packed (Id : E; V : B := True); procedure Set_Is_Packed_Array_Impl_Type (Id : E; V : B := True); + procedure Set_Is_Param_Block_Component_Type (Id : E; V : B := True); procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True); procedure Set_Is_Predicate_Function (Id : E; V : B := True); procedure Set_Is_Predicate_Function_M (Id : E; V : B := True); @@ -8393,6 +8400,7 @@ package Einfo is pragma Inline (Is_Package_Body_Entity); pragma Inline (Is_Packed); pragma Inline (Is_Packed_Array_Impl_Type); + pragma Inline (Is_Param_Block_Component_Type); pragma Inline (Is_Potentially_Use_Visible); pragma Inline (Is_Predicate_Function); pragma Inline (Is_Predicate_Function_M); @@ -8861,6 +8869,7 @@ package Einfo is pragma Inline (Set_Is_Package_Body_Entity); pragma Inline (Set_Is_Packed); pragma Inline (Set_Is_Packed_Array_Impl_Type); + pragma Inline (Set_Is_Param_Block_Component_Type); pragma Inline (Set_Is_Potentially_Use_Visible); pragma Inline (Set_Is_Predicate_Function); pragma Inline (Set_Is_Predicate_Function_M); diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 5d1635171d9..0cb37432630 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -1809,6 +1809,7 @@ package body Exp_Ch9 is -- type Ann is access all Comp_Nam := Make_Temporary (Loc, 'A'); + Set_Is_Param_Block_Component_Type (Comp_Nam); Append_To (Decls, Make_Full_Type_Declaration (Loc, @@ -8326,6 +8327,7 @@ package body Exp_Ch9 is -- Declare new access type and then append Ctype := Make_Temporary (Loc, 'A'); + Set_Is_Param_Block_Component_Type (Ctype); Decl := Make_Full_Type_Declaration (Loc, diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 86b2a6d295c..308808bd4dd 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -3030,8 +3030,23 @@ package body Ch3 is Set_Discriminant_Type (Specification_Node, P_Access_Definition (Not_Null_Present)); - else + -- Catch ouf-of-order keywords + + elsif Token = Tok_Constant then + Scan; + + if Token = Tok_Access then + Error_Msg_SC ("CONSTANT must appear after ACCESS"); + Set_Discriminant_Type + (Specification_Node, + P_Access_Definition (Not_Null_Present)); + + else + Error_Msg_SC ("misplaced CONSTANT"); + end if; + + else Set_Discriminant_Type (Specification_Node, P_Subtype_Mark); No_Constraint; diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 01fd0cd969e..1f60e2d1609 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -1506,7 +1506,9 @@ package body Sem_Elab is or else Elaboration_Checks_Suppressed (Ent) or else Elaboration_Checks_Suppressed (Scope (Ent)) then - Set_No_Elaboration_Check (N); + if Nkind (N) in N_Subprogram_Call then + Set_No_Elaboration_Check (N); + end if; end if; return;