Commit b54d1d39 by Arnaud Charlet

[multiple changes]

2015-10-20  Bob Duff  <duff@adacore.com>

	* a-cobove.adb (Set_Length): Restore previous logic, but with "Checks
	and then" on the check.

2015-10-20  Ed Schonberg  <schonberg@adacore.com>

	* par-ch3.adb (P_Known_Discriminant_Part_Opt): Handle properly
	a misplaced "constant" keyword in a discriminant specification.

2015-10-20  Steve Baird  <baird@adacore.com>

	* 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  <baird@adacore.com>

	* 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  <gingold@adacore.com>

	* adaint.c: File names are case sensitive on aarch64-ios.

From-SVN: r229051
parent 1f8f3e6e
2015-10-20 Bob Duff <duff@adacore.com> 2015-10-20 Bob Duff <duff@adacore.com>
* a-cobove.adb (Set_Length): Restore previous logic, but with "Checks
and then" on the check.
2015-10-20 Ed Schonberg <schonberg@adacore.com>
* par-ch3.adb (P_Known_Discriminant_Part_Opt): Handle properly
a misplaced "constant" keyword in a discriminant specification.
2015-10-20 Steve Baird <baird@adacore.com>
* 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 <baird@adacore.com>
* 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 <gingold@adacore.com>
* adaint.c: File names are case sensitive on aarch64-ios.
2015-10-20 Bob Duff <duff@adacore.com>
* a-cbdlli.ads, a-cbhase.ads, a-cbmutr.ads, a-cborse.ads, * a-cbdlli.ads, a-cbhase.ads, a-cbmutr.ads, a-cborse.ads,
* a-cdlili.ads, a-cidlli.ads, a-cihase.ads, a-cimutr.ads, * a-cdlili.ads, a-cidlli.ads, a-cihase.ads, a-cimutr.ads,
* a-ciorse.ads, a-cobove.ads, a-cohase.ads, a-coinve.ads, * a-ciorse.ads, a-cobove.ads, a-cohase.ads, a-coinve.ads,
......
...@@ -2411,13 +2411,11 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -2411,13 +2411,11 @@ package body Ada.Containers.Bounded_Vectors is
if Count >= 0 then if Count >= 0 then
Container.Delete_Last (Count); Container.Delete_Last (Count);
end if; elsif Checks and then Container.Last >= Index_Type'Last then
if Checks and then Container.Last >= Index_Type'Last then
raise Constraint_Error with "vector is already at its maximum length"; raise Constraint_Error with "vector is already at its maximum length";
else
Container.Insert_Space (Container.Last + 1, -Count);
end if; end if;
Container.Insert_Space (Container.Last + 1, -Count);
end Set_Length; end Set_Length;
---------- ----------
......
...@@ -552,7 +552,8 @@ __gnat_get_file_names_case_sensitive (void) ...@@ -552,7 +552,8 @@ __gnat_get_file_names_case_sensitive (void)
{ {
/* By default, we suppose filesystems aren't case sensitive on /* By default, we suppose filesystems aren't case sensitive on
Windows and Darwin (but they are on arm-darwin). */ 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; file_names_case_sensitive_cache = 0;
#else #else
file_names_case_sensitive_cache = 1; file_names_case_sensitive_cache = 1;
......
...@@ -516,6 +516,7 @@ package body Einfo is ...@@ -516,6 +516,7 @@ package body Einfo is
-- Has_Pragma_Unreferenced_Objects Flag212 -- Has_Pragma_Unreferenced_Objects Flag212
-- Requires_Overriding Flag213 -- Requires_Overriding Flag213
-- Has_RACW Flag214 -- Has_RACW Flag214
-- Is_Param_Block_Component_Type Flag215
-- Universal_Aliasing Flag216 -- Universal_Aliasing Flag216
-- Suppress_Value_Tracking_On_Call Flag217 -- Suppress_Value_Tracking_On_Call Flag217
-- Is_Primitive Flag218 -- Is_Primitive Flag218
...@@ -2317,6 +2318,12 @@ package body Einfo is ...@@ -2317,6 +2318,12 @@ package body Einfo is
return Flag138 (Id); return Flag138 (Id);
end Is_Packed_Array_Impl_Type; 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 function Is_Potentially_Use_Visible (Id : E) return B is
begin begin
pragma Assert (Nkind (Id) in N_Entity); pragma Assert (Nkind (Id) in N_Entity);
...@@ -5281,6 +5288,12 @@ package body Einfo is ...@@ -5281,6 +5288,12 @@ package body Einfo is
Set_Flag138 (Id, V); Set_Flag138 (Id, V);
end Set_Is_Packed_Array_Impl_Type; 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 procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True) is
begin begin
pragma Assert (Nkind (Id) in N_Entity); pragma Assert (Nkind (Id) in N_Entity);
...@@ -8851,6 +8864,7 @@ package body Einfo is ...@@ -8851,6 +8864,7 @@ package body Einfo is
W ("Is_Package_Body_Entity", Flag160 (Id)); W ("Is_Package_Body_Entity", Flag160 (Id));
W ("Is_Packed", Flag51 (Id)); W ("Is_Packed", Flag51 (Id));
W ("Is_Packed_Array_Impl_Type", Flag138 (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_Potentially_Use_Visible", Flag9 (Id));
W ("Is_Predicate_Function", Flag255 (Id)); W ("Is_Predicate_Function", Flag255 (Id));
W ("Is_Predicate_Function_M", Flag256 (Id)); W ("Is_Predicate_Function_M", Flag256 (Id));
......
...@@ -2270,8 +2270,7 @@ package Einfo is ...@@ -2270,8 +2270,7 @@ package Einfo is
-- parent, we do not consider them to be separate units for this flag). -- parent, we do not consider them to be separate units for this flag).
-- Is_Completely_Hidden (Flag103) -- Is_Completely_Hidden (Flag103)
-- Defined in all entities. This flag can be set only for E_Discriminant -- Defined on discriminants. Only set on girder discriminants of
-- entities. This flag can be set only for girder discriminants of
-- untagged types. When set, the entity is a girder discriminant of a -- untagged types. When set, the entity is a girder discriminant of a
-- derived untagged type which is not directly visible in the derived -- derived untagged type which is not directly visible in the derived
-- type because the derived type or one of its ancestors have renamed the -- type because the derived type or one of its ancestors have renamed the
...@@ -2848,6 +2847,11 @@ package Einfo is ...@@ -2848,6 +2847,11 @@ package Einfo is
-- set in an entity, then the Original_Array_Type field of this entity -- 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. -- 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) -- Is_Potentially_Use_Visible (Flag9)
-- Defined in all entities. Set if entity is potentially use visible, -- 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 -- i.e. it is defined in a package that appears in a currently active
...@@ -5300,7 +5304,6 @@ package Einfo is ...@@ -5300,7 +5304,6 @@ package Einfo is
-- Is_Checked_Ghost_Entity (Flag277) -- Is_Checked_Ghost_Entity (Flag277)
-- Is_Child_Unit (Flag73) -- Is_Child_Unit (Flag73)
-- Is_Compilation_Unit (Flag149) -- Is_Compilation_Unit (Flag149)
-- Is_Completely_Hidden (Flag103)
-- Is_Descendent_Of_Address (Flag223) -- Is_Descendent_Of_Address (Flag223)
-- Is_Discrim_SO_Function (Flag176) -- Is_Discrim_SO_Function (Flag176)
-- Is_Discriminant_Check_Function (Flag264) -- Is_Discriminant_Check_Function (Flag264)
...@@ -5526,6 +5529,7 @@ package Einfo is ...@@ -5526,6 +5529,7 @@ package Einfo is
-- Is_Pure_Unit_Access_Type (Flag189) -- Is_Pure_Unit_Access_Type (Flag189)
-- No_Pool_Assigned (Flag131) (base type only) -- No_Pool_Assigned (Flag131) (base type only)
-- No_Strict_Aliasing (Flag136) (base type only) -- No_Strict_Aliasing (Flag136) (base type only)
-- Is_Param_Block_Component_Type (Flag215) (base type only)
-- (plus type attributes) -- (plus type attributes)
-- E_Access_Attribute_Type -- E_Access_Attribute_Type
...@@ -5706,6 +5710,7 @@ package Einfo is ...@@ -5706,6 +5710,7 @@ package Einfo is
-- Discriminant_Default_Value (Node20) -- Discriminant_Default_Value (Node20)
-- Original_Record_Component (Node22) -- Original_Record_Component (Node22)
-- CR_Discriminant (Node23) -- CR_Discriminant (Node23)
-- Is_Completely_Hidden (Flag103)
-- Is_Return_Object (Flag209) -- Is_Return_Object (Flag209)
-- Next_Component_Or_Discriminant (synth) -- Next_Component_Or_Discriminant (synth)
-- Next_Discriminant (synth) -- Next_Discriminant (synth)
...@@ -6927,6 +6932,7 @@ package Einfo is ...@@ -6927,6 +6932,7 @@ package Einfo is
function Is_Packed (Id : E) return B; function Is_Packed (Id : E) return B;
function Is_Packed_Array_Impl_Type (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_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 (Id : E) return B;
function Is_Predicate_Function_M (Id : E) return B; function Is_Predicate_Function_M (Id : E) return B;
function Is_Preelaborated (Id : E) return B; function Is_Preelaborated (Id : E) return B;
...@@ -7587,6 +7593,7 @@ package Einfo is ...@@ -7587,6 +7593,7 @@ package Einfo is
procedure Set_Is_Package_Body_Entity (Id : E; V : B := True); procedure Set_Is_Package_Body_Entity (Id : E; V : B := True);
procedure Set_Is_Packed (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_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_Potentially_Use_Visible (Id : E; V : B := True);
procedure Set_Is_Predicate_Function (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); procedure Set_Is_Predicate_Function_M (Id : E; V : B := True);
...@@ -8393,6 +8400,7 @@ package Einfo is ...@@ -8393,6 +8400,7 @@ package Einfo is
pragma Inline (Is_Package_Body_Entity); pragma Inline (Is_Package_Body_Entity);
pragma Inline (Is_Packed); pragma Inline (Is_Packed);
pragma Inline (Is_Packed_Array_Impl_Type); pragma Inline (Is_Packed_Array_Impl_Type);
pragma Inline (Is_Param_Block_Component_Type);
pragma Inline (Is_Potentially_Use_Visible); pragma Inline (Is_Potentially_Use_Visible);
pragma Inline (Is_Predicate_Function); pragma Inline (Is_Predicate_Function);
pragma Inline (Is_Predicate_Function_M); pragma Inline (Is_Predicate_Function_M);
...@@ -8861,6 +8869,7 @@ package Einfo is ...@@ -8861,6 +8869,7 @@ package Einfo is
pragma Inline (Set_Is_Package_Body_Entity); pragma Inline (Set_Is_Package_Body_Entity);
pragma Inline (Set_Is_Packed); pragma Inline (Set_Is_Packed);
pragma Inline (Set_Is_Packed_Array_Impl_Type); 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_Potentially_Use_Visible);
pragma Inline (Set_Is_Predicate_Function); pragma Inline (Set_Is_Predicate_Function);
pragma Inline (Set_Is_Predicate_Function_M); pragma Inline (Set_Is_Predicate_Function_M);
......
...@@ -1809,6 +1809,7 @@ package body Exp_Ch9 is ...@@ -1809,6 +1809,7 @@ package body Exp_Ch9 is
-- type Ann is access all <actual-type> -- type Ann is access all <actual-type>
Comp_Nam := Make_Temporary (Loc, 'A'); Comp_Nam := Make_Temporary (Loc, 'A');
Set_Is_Param_Block_Component_Type (Comp_Nam);
Append_To (Decls, Append_To (Decls,
Make_Full_Type_Declaration (Loc, Make_Full_Type_Declaration (Loc,
...@@ -8326,6 +8327,7 @@ package body Exp_Ch9 is ...@@ -8326,6 +8327,7 @@ package body Exp_Ch9 is
-- Declare new access type and then append -- Declare new access type and then append
Ctype := Make_Temporary (Loc, 'A'); Ctype := Make_Temporary (Loc, 'A');
Set_Is_Param_Block_Component_Type (Ctype);
Decl := Decl :=
Make_Full_Type_Declaration (Loc, Make_Full_Type_Declaration (Loc,
......
...@@ -3030,8 +3030,23 @@ package body Ch3 is ...@@ -3030,8 +3030,23 @@ package body Ch3 is
Set_Discriminant_Type Set_Discriminant_Type
(Specification_Node, (Specification_Node,
P_Access_Definition (Not_Null_Present)); 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 Set_Discriminant_Type
(Specification_Node, P_Subtype_Mark); (Specification_Node, P_Subtype_Mark);
No_Constraint; No_Constraint;
......
...@@ -1506,7 +1506,9 @@ package body Sem_Elab is ...@@ -1506,7 +1506,9 @@ package body Sem_Elab is
or else Elaboration_Checks_Suppressed (Ent) or else Elaboration_Checks_Suppressed (Ent)
or else Elaboration_Checks_Suppressed (Scope (Ent)) or else Elaboration_Checks_Suppressed (Scope (Ent))
then then
Set_No_Elaboration_Check (N); if Nkind (N) in N_Subprogram_Call then
Set_No_Elaboration_Check (N);
end if;
end if; end if;
return; return;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment