aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/ada/ChangeLog36
-rw-r--r--gcc/ada/a-cobove.adb8
-rw-r--r--gcc/ada/adaint.c3
-rw-r--r--gcc/ada/einfo.adb14
-rw-r--r--gcc/ada/einfo.ads15
-rw-r--r--gcc/ada/exp_ch9.adb2
-rw-r--r--gcc/ada/par-ch3.adb17
-rw-r--r--gcc/ada/sem_elab.adb4
8 files changed, 88 insertions, 11 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 63ad655..fd2f4f6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,41 @@
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-cdlili.ads, a-cidlli.ads, a-cihase.ads, a-cimutr.ads,
* a-ciorse.ads, a-cobove.ads, a-cohase.ads, a-coinve.ads,
diff --git a/gcc/ada/a-cobove.adb b/gcc/ada/a-cobove.adb
index 4db3923..4fa7ce8 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 813d2c1..6849cd1 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 5adc28f..c6a9998 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 d32f01d..f536615 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 5d16351..0cb3743 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 <actual-type>
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 86b2a6d..308808b 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 01fd0cd..1f60e2d 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;
generated by cgit v1.1 at 2024-09-28 06:41:53 +0000