+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,
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;
----------
{
/* 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;
-- 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
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);
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);
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));
-- 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
-- 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
-- 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)
-- 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
-- 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)
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;
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);
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);
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);
-- type Ann is access all <actual-type>
Comp_Nam := Make_Temporary (Loc, 'A');
+ Set_Is_Param_Block_Component_Type (Comp_Nam);
Append_To (Decls,
Make_Full_Type_Declaration (Loc,
-- 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,
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;
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;
projects / gcc.git / commitdiff