aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gcc/ada/ChangeLog31
-rw-r--r--gcc/ada/checks.adb13
-rw-r--r--gcc/ada/checks.ads1
-rw-r--r--gcc/ada/exp_ch7.adb2
-rw-r--r--gcc/ada/exp_util.adb15
-rw-r--r--gcc/ada/gnat_rm.texi72
-rw-r--r--gcc/ada/sem_attr.adb99
-rw-r--r--gcc/ada/sem_res.adb18
-rw-r--r--gcc/ada/sem_util.adb1
-rw-r--r--gcc/ada/sinfo.adb16
-rw-r--r--gcc/ada/sinfo.ads19
-rw-r--r--gcc/ada/snames.ads-tmpl3
-rw-r--r--gcc/ada/types.ads31
13 files changed, 254 insertions, 67 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 76cab67..a710911 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,34 @@
+2014-07-16 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch7.adb (Process_Declarations): Reinstate the check on
+ a hook object to ensure that the related transient declaration
+ is finalizable.
+ * exp_util.adb (Is_Aliased): Do not consider expresison with
+ actions as a special context.
+ (Requires_Cleanup_Actions): Reinstate the check on a hook object to
+ ensure that the related transient declaration is finalizable.
+
+2014-07-16 Robert Dewar <dewar@adacore.com>
+
+ * checks.ads, checks.adb (Allocation_Checks_Suppressed): New function.
+ * snames.ads-tmpl: Add Allocation_Check to list of check names.
+ * types.ads: Add Allocation_Check to list of check names.
+
+2014-07-16 Thomas Quinot <quinot@adacore.com>
+
+ * sem_util.adb (Enter_Name): replace bogus test for presence of
+ Corresponding_Remote_Type with correct test on Ekind.
+ * sem_res.adb (Valid_Conversion): ditto; also clarify validity
+ of calls to Corresponding_ Remote_Type (documentation fix).
+
+2014-07-16 Robert Dewar <dewar@adacore.com>
+
+ * gnat_rm.texi: Document illegal case of Unrestricted_Access.
+ * sem_attr.adb (Analyze_Access_Attribute): Set_Non_Aliased_Prefix
+ where it applies.
+ (Resolve_Attribute, case Access): Flag illegal Unrestricted_Access use.
+ * sinfo.ads, sinfo.adb (Non_Aliased_Prefix): New flag.
+
2014-07-16 Robert Dewar <dewar@adacore.com>
* gnat_ugn.texi: Document binder switch -Ra.
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 61d0324..87777de 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -419,6 +419,19 @@ package body Checks is
end if;
end Alignment_Checks_Suppressed;
+ ----------------------------------
+ -- Allocation_Checks_Suppressed --
+ ----------------------------------
+
+ function Allocation_Checks_Suppressed (E : Entity_Id) return Boolean is
+ begin
+ if Present (E) and then Checks_May_Be_Suppressed (E) then
+ return Is_Check_Suppressed (E, Allocation_Check);
+ else
+ return Scope_Suppress.Suppress (Allocation_Check);
+ end if;
+ end Allocation_Checks_Suppressed;
+
-------------------------
-- Append_Range_Checks --
-------------------------
diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index 1c6b810..f825e5e 100644
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -50,6 +50,7 @@ package Checks is
function Access_Checks_Suppressed (E : Entity_Id) return Boolean;
function Accessibility_Checks_Suppressed (E : Entity_Id) return Boolean;
function Alignment_Checks_Suppressed (E : Entity_Id) return Boolean;
+ function Allocation_Checks_Suppressed (E : Entity_Id) return Boolean;
function Atomic_Synchronization_Disabled (E : Entity_Id) return Boolean;
function Discriminant_Checks_Suppressed (E : Entity_Id) return Boolean;
function Division_Checks_Suppressed (E : Entity_Id) return Boolean;
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 9a135bd..bee169d 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -1825,6 +1825,8 @@ package body Exp_Ch7 is
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
and then Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) =
N_Object_Declaration
+ and then Is_Finalizable_Transient
+ (Status_Flag_Or_Transient_Decl (Obj_Id), Decl)
then
Processing_Actions (Has_No_Init => True);
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index bd0e5aac..2d2d7f5 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -4562,18 +4562,7 @@ package body Exp_Util is
elsif Nkind (Stmt) = N_Object_Renaming_Declaration then
Ren_Obj := Find_Renamed_Object (Stmt);
- if Present (Ren_Obj)
- and then Ren_Obj = Trans_Id
-
- -- When the related context is an expression with actions,
- -- both the transient controlled object and its renaming are
- -- bound by the "scope" of the expression with actions. In
- -- other words, the two cannot be visible outside the scope,
- -- therefore the lifetime of the transient object is not
- -- really extended by the renaming.
-
- and then Nkind (Rel_Node) /= N_Expression_With_Actions
- then
+ if Present (Ren_Obj) and then Ren_Obj = Trans_Id then
return True;
end if;
end if;
@@ -7344,6 +7333,8 @@ package body Exp_Util is
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
and then Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) =
N_Object_Declaration
+ and then Is_Finalizable_Transient
+ (Status_Flag_Or_Transient_Decl (Obj_Id), Decl)
then
return True;
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index a223d3d..0781698 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -9551,22 +9551,65 @@ is in scope (normal Ada accessibility rules restrict this usage).
It is possible to use @code{Unrestricted_Access} for any type, but care
must be exercised if it is used to create pointers to unconstrained array
-objects. In this case, the resulting pointer has the same scope as the
+objects. In this case, the resulting pointer has the same scope as the
context of the attribute, and may not be returned to some enclosing
-scope. For instance, a function cannot use @code{Unrestricted_Access}
+scope. For instance, a function cannot use @code{Unrestricted_Access}
to create a unconstrained pointer and then return that value to the
-caller. In addition, it is only valid to create pointers to unconstrained
+caller. In addition, it is only valid to create pointers to unconstrained
arrays using this attribute if the pointer has the normal default ``fat''
representation where a pointer has two components, one points to the array
-and one points to the bounds. If a size clause is used to force ``thin''
+and one points to the bounds. If a size clause is used to force ``thin''
representation for a pointer to unconstrained where there is only space for
-a single pointer, then any use of @code{Unrestricted_Access}
-to create a value of such a type (e.g. by conversion from fat to
-thin pointers) is erroneous. Consider the following example:
+a single pointer, then the resulting pointer is not usable.
+
+In the simple case where a direct use of Unrestricted_Access attempts
+to make a thin pointer for a non-aliased object, the compiler will
+reject the use as illegal, as shown in the following example:
@smallexample @c ada
with System; use System;
+procedure SliceUA2 is
+ type A is access all String;
+ for A'Size use Standard'Address_Size;
+
+ procedure P (Arg : A) is
+ begin
+ null;
+ end P;
+
+ X : String := "hello world!";
+ X2 : aliased String := "hello world!";
+
+ AV : A := X'Unrestricted_Access; -- ERROR
+ |
+>>> illegal use of Unrestricted_Access attribute
+>>> attempt to generate thin pointer to unaliased object
+
+begin
+ P (X'Unrestricted_Access); -- ERROR
+ |
+>>> illegal use of Unrestricted_Access attribute
+>>> attempt to generate thin pointer to unaliased object
+
+ P (X(7 .. 12)'Unrestricted_Access); -- ERROR
+ |
+>>> illegal use of Unrestricted_Access attribute
+>>> attempt to generate thin pointer to unaliased object
+
+ P (X2'Unrestricted_Access); -- OK
+end;
+@end smallexample
+
+@noindent
+but other cases cannot be detected by the compiler, and are
+considered to be erroneous. Consider the following example:
+
+@smallexample @c ada
+with System; use System;
+with System; use System;
procedure SliceUA is
+ type AF is access all String;
+
type A is access all String;
for A'Size use Standard'Address_Size;
@@ -9578,28 +9621,29 @@ procedure SliceUA is
end P;
X : String := "hello world!";
+ Y : AF := X (7 .. 12)'Unrestricted_Access;
begin
- P (X(7 .. 12)'Unrestricted_Access);
+ P (A (Y));
end;
@end smallexample
@noindent
-This inevitably raises @code{Program_Error}.
A normal unconstrained array value
or a constrained array object marked as aliased has the bounds in memory
just before the array, so a thin pointer can retrieve both the data and
-the bounds. But in this case, the non-aliased object @code{X} does not have the
-bounds before the string. If the size clause for type @code{A}
+the bounds. But in this case, the non-aliased object @code{X} does not have the
+bounds before the string. If the size clause for type @code{A}
were not present, then the pointer
would be a fat pointer, where one component is a pointer to the bounds,
-and all would be well. But with the size clause present, the conversion from
-fat pointer to think pointer in the call looses the bounds.
+and all would be well. But with the size clause present, the conversion from
+fat pointer to thin pointer in the call looses the bounds, and so this
+program raises a @code{Program_Error} exception if executed.
In general, it is advisable to completely
avoid mixing the use of thin pointers and the use of
@code{Unrestricted_Access} where the designated type is an
-unconstrained array. The use of thin pointers should be restricted to
+unconstrained array. The use of thin pointers should be restricted to
cases of porting legacy code which implicitly assumes the size of pointers,
and such code should not in any case be using this attribute.
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 22e2d5b..8c46dd8 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -764,9 +764,7 @@ package body Sem_Attr is
-- Case of access to subprogram
- if Is_Entity_Name (P)
- and then Is_Overloadable (Entity (P))
- then
+ if Is_Entity_Name (P) and then Is_Overloadable (Entity (P)) then
if Has_Pragma_Inline_Always (Entity (P)) then
Error_Attr_P
("prefix of % attribute cannot be Inline_Always subprogram");
@@ -961,15 +959,17 @@ package body Sem_Attr is
end if;
end if;
- -- If we fall through, we have a normal access to object case.
- -- Unrestricted_Access is legal wherever an allocator would be
- -- legal, so its Etype is set to E_Allocator. The expected type
+ -- If we fall through, we have a normal access to object case
+
+ -- Unrestricted_Access is (for now) legal wherever an allocator would
+ -- be legal, so its Etype is set to E_Allocator. The expected type
-- of the other attributes is a general access type, and therefore
-- we label them with E_Access_Attribute_Type.
if not Is_Overloaded (P) then
Acc_Type := Build_Access_Object_Type (P_Type);
Set_Etype (N, Acc_Type);
+
else
declare
Index : Interp_Index;
@@ -1022,21 +1022,42 @@ package body Sem_Attr is
end loop;
end;
- -- Check for aliased view unless unrestricted case. We allow a
- -- nonaliased prefix when within an instance because the prefix may
- -- have been a tagged formal object, which is defined to be aliased
- -- even when the actual might not be (other instance cases will have
- -- been caught in the generic). Similarly, within an inlined body we
- -- know that the attribute is legal in the original subprogram, and
- -- therefore legal in the expansion.
+ -- Check for aliased view.. We allow a nonaliased prefix when within
+ -- an instance because the prefix may have been a tagged formal
+ -- object, which is defined to be aliased even when the actual
+ -- might not be (other instance cases will have been caught in the
+ -- generic). Similarly, within an inlined body we know that the
+ -- attribute is legal in the original subprogram, and therefore
+ -- legal in the expansion.
- if Aname /= Name_Unrestricted_Access
- and then not Is_Aliased_View (P)
+ if not Is_Aliased_View (P)
and then not In_Instance
and then not In_Inlined_Body
then
- Error_Attr_P ("prefix of % attribute must be aliased");
- Check_No_Implicit_Aliasing (P);
+ -- Here we have a non-aliased view. This is illegal unless we
+ -- have the case of Unrestricted_Access, where for now we allow
+ -- this (we will reject later if expected type is access to an
+ -- unconstrained array with a thin pointer).
+
+ if Aname /= Name_Unrestricted_Access then
+ Error_Attr_P ("prefix of % attribute must be aliased");
+ Check_No_Implicit_Aliasing (P);
+
+ -- For Unrestricted_Access, record that prefix is not aliased
+ -- to simplify legality check later on.
+
+ else
+ Set_Non_Aliased_Prefix (N);
+ end if;
+
+ -- If we have an aliased view, and we have Unrestricted_Access, then
+ -- output a warning that Unchecked_Access would have been fine, and
+ -- change the node to be Unchecked_Access.
+
+ else
+ -- For now, hold off on this change ???
+
+ null;
end if;
end Analyze_Access_Attribute;
@@ -9726,10 +9747,10 @@ package body Sem_Attr is
Note_Possible_Modification (P, Sure => False);
end if;
- -- The following comes from a query by Adam Beneschan, concerning
- -- improper use of universal_access in equality tests involving
- -- anonymous access types. Another good reason for 'Ref, but
- -- for now disable the test, which breaks several filed tests.
+ -- The following comes from a query concerning improper use of
+ -- universal_access in equality tests involving anonymous access
+ -- types. Another good reason for 'Ref, but for now disable the
+ -- test, which breaks several filed tests???
if Ekind (Typ) = E_Anonymous_Access_Type
and then Nkind_In (Parent (N), N_Op_Eq, N_Op_Ne)
@@ -9739,7 +9760,12 @@ package body Sem_Attr is
Error_Msg_N ("\qualify attribute with some access type", N);
end if;
+ -- Case where prefix is an entity name
+
if Is_Entity_Name (P) then
+
+ -- Deal with case where prefix itself is overloaded
+
if Is_Overloaded (P) then
Get_First_Interp (P, Index, It);
while Present (It.Nam) loop
@@ -9772,12 +9798,19 @@ package body Sem_Attr is
Freeze_Before (N, Entity (P));
end if;
+ -- Nothing to do if prefix is a type name
+
elsif Is_Type (Entity (P)) then
null;
+
+ -- Otherwise non-overloaded other case, resolve the prefix
+
else
Resolve (P);
end if;
+ -- Some further error checks
+
Error_Msg_Name_1 := Aname;
if not Is_Entity_Name (P) then
@@ -10109,7 +10142,7 @@ package body Sem_Attr is
or else
Attr_Id = Attribute_Unchecked_Access)
and then (Ekind (Btyp) = E_General_Access_Type
- or else Ekind (Btyp) = E_Anonymous_Access_Type)
+ or else Ekind (Btyp) = E_Anonymous_Access_Type)
then
-- Ada 2005 (AI-230): Check the accessibility of anonymous
-- access types for stand-alone objects, record and array
@@ -10358,6 +10391,28 @@ package body Sem_Attr is
end if;
end if;
+ -- Check for unrestricted access where expected type is a thin
+ -- pointer to an unconstrained array.
+
+ if Non_Aliased_Prefix (N)
+ and then Has_Size_Clause (Typ)
+ and then RM_Size (Typ) = System_Address_Size
+ then
+ declare
+ DT : constant Entity_Id := Designated_Type (Typ);
+ begin
+ if Is_Array_Type (DT) and then not Is_Constrained (DT) then
+ Error_Msg_N
+ ("illegal use of Unrestricted_Access attribute", P);
+ Error_Msg_N
+ ("\attempt to generate thin pointer to unaliased "
+ & "object", P);
+ end if;
+ end;
+ end if;
+
+ -- Mark that address of entity is taken
+
if Is_Entity_Name (P) then
Set_Address_Taken (Entity (P));
end if;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 90a362c..4ad60a9 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -11799,7 +11799,12 @@ package body Sem_Res is
-- after the return.
elsif Is_Access_Subprogram_Type (Target_Type)
- and then No (Corresponding_Remote_Type (Opnd_Type))
+
+ -- Note: this test of Ekind (Opnd_Type) is there to prevent entering
+ -- this branch in the case of a remote access to subprogram type,
+ -- which is internally represented as an E_Record_Type.
+
+ and then Ekind (Opnd_Type) in Access_Kind
then
if Ekind (Base_Type (Opnd_Type)) = E_Anonymous_Access_Subprogram_Type
and then Is_Entity_Name (Operand)
@@ -11864,7 +11869,7 @@ package body Sem_Res is
return True;
- -- Remote subprogram access types
+ -- Remote access to subprogram types
elsif Is_Remote_Access_To_Subprogram_Type (Target_Type)
and then Is_Remote_Access_To_Subprogram_Type (Opnd_Type)
@@ -11872,6 +11877,15 @@ package body Sem_Res is
-- It is valid to convert from one RAS type to another provided
-- that their specification statically match.
+ -- Note: at this point, remote access to subprogram types have been
+ -- expanded to their E_Record_Type representation, and we need to
+ -- go back to the original access type definition using the
+ -- Corresponding_Remote_Type attribute in order to check that the
+ -- designated profiles match.
+
+ pragma Assert (Ekind (Target_Type) = E_Record_Type);
+ pragma Assert (Ekind (Opnd_Type) = E_Record_Type);
+
Check_Subtype_Conformant
(New_Id =>
Designated_Type (Corresponding_Remote_Type (Target_Type)),
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 7bc8232..4aae4f8 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5045,6 +5045,7 @@ package body Sem_Util is
-- visibility list (see below).
elsif Nkind (Parent (Def_Id)) = N_Full_Type_Declaration
+ and then Ekind (Def_Id) = E_Record_Type
and then Present (Corresponding_Remote_Type (Def_Id))
then
null;
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 0c1a777..ade3b4e 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -2338,6 +2338,14 @@ package body Sinfo is
return Flag17 (N);
end No_Truncation;
+ function Non_Aliased_Prefix
+ (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Attribute_Reference);
+ return Flag18 (N);
+ end Non_Aliased_Prefix;
+
function Null_Present
(N : Node_Id) return Boolean is
begin
@@ -5487,6 +5495,14 @@ package body Sinfo is
Set_Flag17 (N, Val);
end Set_No_Truncation;
+ procedure Set_Non_Aliased_Prefix
+ (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Attribute_Reference);
+ Set_Flag18 (N, Val);
+ end Set_Non_Aliased_Prefix;
+
procedure Set_Null_Present
(N : Node_Id; Val : Boolean := True) is
begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 73dea2a..521ab0b 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1809,6 +1809,13 @@ package Sinfo is
-- is used for properly setting out of range values for use by pragmas
-- Initialize_Scalars and Normalize_Scalars.
+ -- Non_Aliased_Prefix (Flag18-Sem)
+ -- Present in N_Attribute_Reference nodes. Set only for the case of an
+ -- Unrestricted_Access reference whose prefix is non-aliased, which is
+ -- the case that is permitted for Unrestricted_Access except when the
+ -- expected type is a thin pointer to unconstrained array. This flag is
+ -- to assist in detecting this illegal use of Unrestricted_Access.
+
-- Original_Discriminant (Node2-Sem)
-- Present in identifiers. Used in references to discriminants that
-- appear in generic units. Because the names of the discriminants may be
@@ -3621,8 +3628,10 @@ package Sinfo is
-- Associated_Node (Node4-Sem)
-- Do_Overflow_Check (Flag17-Sem)
-- Header_Size_Added (Flag11-Sem)
+ -- Must_Be_Byte_Aligned (Flag14-Sem)
+ -- Non_Aliased_Prefix (Flag18-Sem)
-- Redundant_Use (Flag13-Sem)
- -- Must_Be_Byte_Aligned (Flag14)
+
-- plus fields for expression
-- Note: in Modify_Tree_For_C mode, Max and Min attributes are expanded
@@ -9242,6 +9251,9 @@ package Sinfo is
function No_Truncation
(N : Node_Id) return Boolean; -- Flag17
+ function Non_Aliased_Prefix
+ (N : Node_Id) return Boolean; -- Flag18
+
function Null_Present
(N : Node_Id) return Boolean; -- Flag13
@@ -10244,6 +10256,9 @@ package Sinfo is
procedure Set_No_Truncation
(N : Node_Id; Val : Boolean := True); -- Flag17
+ procedure Set_Non_Aliased_Prefix
+ (N : Node_Id; Val : Boolean := True); -- Flag18
+
procedure Set_Null_Present
(N : Node_Id; Val : Boolean := True); -- Flag13
@@ -12510,6 +12525,7 @@ package Sinfo is
pragma Inline (No_Initialization);
pragma Inline (No_Minimize_Eliminate);
pragma Inline (No_Truncation);
+ pragma Inline (Non_Aliased_Prefix);
pragma Inline (Null_Present);
pragma Inline (Null_Exclusion_Present);
pragma Inline (Null_Exclusion_In_Return_Present);
@@ -12840,6 +12856,7 @@ package Sinfo is
pragma Inline (Set_No_Initialization);
pragma Inline (Set_No_Minimize_Eliminate);
pragma Inline (Set_No_Truncation);
+ pragma Inline (Set_Non_Aliased_Prefix);
pragma Inline (Set_Null_Exclusion_Present);
pragma Inline (Set_Null_Exclusion_In_Return_Present);
pragma Inline (Set_Null_Present);
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index ec99f31..0ea1beb 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -1096,6 +1096,7 @@ package Snames is
Name_Access_Check : constant Name_Id := N + $;
Name_Accessibility_Check : constant Name_Id := N + $;
Name_Alignment_Check : constant Name_Id := N + $; -- GNAT
+ Name_Allocation_Check : constant Name_Id := N + $;
Name_Atomic_Synchronization : constant Name_Id := N + $; -- GNAT
Name_Discriminant_Check : constant Name_Id := N + $;
Name_Division_Check : constant Name_Id := N + $;
diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads
index 58b3438..76e95d6 100644
--- a/gcc/ada/types.ads
+++ b/gcc/ada/types.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -665,23 +665,24 @@ package Types is
Access_Check : constant := 1;
Accessibility_Check : constant := 2;
Alignment_Check : constant := 3;
- Atomic_Synchronization : constant := 4;
- Discriminant_Check : constant := 5;
- Division_Check : constant := 6;
- Elaboration_Check : constant := 7;
- Index_Check : constant := 8;
- Length_Check : constant := 9;
- Overflow_Check : constant := 10;
- Predicate_Check : constant := 11;
- Range_Check : constant := 12;
- Storage_Check : constant := 13;
- Tag_Check : constant := 14;
- Validity_Check : constant := 15;
+ Allocation_Check : constant := 4;
+ Atomic_Synchronization : constant := 5;
+ Discriminant_Check : constant := 6;
+ Division_Check : constant := 7;
+ Elaboration_Check : constant := 8;
+ Index_Check : constant := 9;
+ Length_Check : constant := 10;
+ Overflow_Check : constant := 11;
+ Predicate_Check : constant := 12;
+ Range_Check : constant := 13;
+ Storage_Check : constant := 14;
+ Tag_Check : constant := 15;
+ Validity_Check : constant := 16;
-- Values used to represent individual predefined checks (including the
-- setting of Atomic_Synchronization, which is implemented internally using
-- a "check" whose name is Atomic_Synchronization).
- All_Checks : constant := 16;
+ All_Checks : constant := 17;
-- Value used to represent All_Checks value
subtype Predefined_Check_Id is Check_Id range 1 .. All_Checks;
@@ -704,7 +705,7 @@ package Types is
-- To add a new check type to GNAT, the following steps are required:
- -- 1. Add an entry to Snames spec and body for the new name
+ -- 1. Add an entry to Snames spec for the new name
-- 2. Add an entry to the definition of Check_Id above
-- 3. Add a new function to Checks to handle the new check test
-- 4. Add a new Do_xxx_Check flag to Sinfo (if required)