OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2014-07-29  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_N_Assignment_Statement): If the target type
	is a null-excluding access type, do not generate a constraint
	check if Suppress_Assignment_Checks is set on assignment node.
	* exp_ch9.adb (Build_Simple_Entry_Call): If actual is an out
	parameter of a null-excluding access type, there is access check
	on entry, so set Suppress_Assignment_Checks on generated statement
	that assigns actual to parameter block.
	* sinfo.ads: Document additional use of Suppress_Assignment_Checks.

2014-07-29  Javier Miranda  <miranda@adacore.com>

	* types.ads (Kind): Renamed as Rkind to avoid crashing ASIS.
	* exp_ch11.adb, tbuild.adb Update references to Types.Kind

2014-07-29  Ed Schonberg  <schonberg@adacore.com>

	* par-ch3.adb (P_Type_Declaration): Create end label for
	limited record declaration, previously omitted.

2014-07-29  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Complete list of implementation pragmas Add
	dummy sections for impl pragmas needing documentation.

From-SVN: r213195
This commit is contained in:
Arnaud Charlet 2014-07-29 16:02:19 +02:00
parent effdbb7d57
commit a2cc9797df
9 changed files with 102 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/ada/ChangeLog
View File

@ -1,3 +1,14 @@
2014-07-29 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_N_Assignment_Statement): If the target type
is a null-excluding access type, do not generate a constraint
check if Suppress_Assignment_Checks is set on assignment node.
* exp_ch9.adb (Build_Simple_Entry_Call): If actual is an out
parameter of a null-excluding access type, there is access check
on entry, so set Suppress_Assignment_Checks on generated statement
that assigns actual to parameter block.
* sinfo.ads: Document additional use of Suppress_Assignment_Checks.
2014-07-29 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Change theta to @ in documentation of aspect

2
gcc/ada/exp_ch11.adb
View File

@ -2068,7 +2068,7 @@ package body Exp_Ch11 is
function Get_RT_Exception_Entity (R : RT_Exception_Code) return Entity_Id is
begin
case Kind (R) is
case Rkind (R) is
when CE_Reason => return Standard_Constraint_Error;
when PE_Reason => return Standard_Program_Error;
when SE_Reason => return Standard_Storage_Error;

1
gcc/ada/exp_ch5.adb
View File

@ -2001,6 +2001,7 @@ package body Exp_Ch5 is
if Is_Access_Type (Typ)
and then Can_Never_Be_Null (Etype (Lhs))
and then not Can_Never_Be_Null (Etype (Rhs))
and then not Suppress_Assignment_Checks (N)
then
Apply_Constraint_Check (Rhs, Etype (Lhs));
end if;

4
gcc/ada/exp_ch9.adb
View File

@ -4755,7 +4755,8 @@ package body Exp_Ch9 is
-- case of limited type. We cannot assign it unless the
-- Assignment_OK flag is set first. An out formal of an
-- access type must also be initialized from the actual,
-- as stated in RM 6.4.1 (13).
-- as stated in RM 6.4.1 (13), but no constraint is applied
-- before the call.
if Ekind (Formal) /= E_Out_Parameter
or else Is_Access_Type (Etype (Formal))
@ -4767,6 +4768,7 @@ package body Exp_Ch9 is
Make_Assignment_Statement (Loc,
Name => N_Var,
Expression => Relocate_Node (Actual)));
Set_Suppress_Assignment_Checks (Last (Stats));
end if;
Append (N_Node, Decls);

39
gcc/ada/gnat_rm.texi
View File

@ -112,7 +112,7 @@ Implementation Defined Pragmas
* Pragma Assertion_Policy::
* Pragma Assume::
* Pragma Assume_No_Invalid_Values::
* Pragma Ast_Entry::
* Pragma AST_Entry::
* Pragma Async_Readers::
* Pragma Async_Writers::
* Pragma Attribute_Definition::
@ -196,6 +196,7 @@ Implementation Defined Pragmas
* Pragma Linker_Constructor::
* Pragma Linker_Destructor::
* Pragma Linker_Section::
* Pragma Lock_Free::
* Pragma Long_Float::
* Pragma Loop_Invariant::
* Pragma Loop_Optimize::
@ -234,6 +235,7 @@ Implementation Defined Pragmas
* Pragma Provide_Shift_Operators::
* Pragma Psect_Object::
* Pragma Pure_Function::
* Pragma Rational::
* Pragma Ravenscar::
* Pragma Refined_Depends::
* Pragma Refined_Global::
@ -976,7 +978,7 @@ consideration, the use of these pragmas should be minimized.
* Pragma Assertion_Policy::
* Pragma Assume::
* Pragma Assume_No_Invalid_Values::
* Pragma Ast_Entry::
* Pragma AST_Entry::
* Pragma Async_Readers::
* Pragma Async_Writers::
* Pragma Attribute_Definition::
@ -1060,6 +1062,7 @@ consideration, the use of these pragmas should be minimized.
* Pragma Linker_Constructor::
* Pragma Linker_Destructor::
* Pragma Linker_Section::
* Pragma Lock_Free::
* Pragma Long_Float::
* Pragma Loop_Invariant::
* Pragma Loop_Optimize::
@ -1098,6 +1101,7 @@ consideration, the use of these pragmas should be minimized.
* Pragma Provide_Shift_Operators::
* Pragma Psect_Object::
* Pragma Pure_Function::
* Pragma Rational::
* Pragma Ravenscar::
* Pragma Refined_Depends::
* Pragma Refined_Global::
@ -1673,10 +1677,10 @@ section 7.1.2.
For the description of this pragma, see SPARK 2014 Reference Manual,
section 7.1.2.
@node Pragma Ast_Entry
@unnumberedsec Pragma Ast_Entry
@node Pragma AST_Entry
@unnumberedsec Pragma AST_Entry
@cindex OpenVMS
@findex Ast_Entry
@findex AST_Entry
@noindent
Syntax:
@smallexample @c ada
@ -4488,6 +4492,13 @@ package IO_Card is
end IO_Card;
@end smallexample
@node Pragma Lock_Free
@unnumberedsec Pragma Locl_Free
@findex Lock_Free
@noindent
Syntax:
PLEASE ADD DOCUMENTATION HERE???
@node Pragma Long_Float
@unnumberedsec Pragma Long_Float
@cindex OpenVMS
@ -6089,6 +6100,24 @@ function is also considered pure from an optimization point of view, but the
unit is not a Pure unit in the categorization sense. So for example, a function
thus marked is free to @code{with} non-pure units.
@node Pragma Rational
@unnumberedsec Pragma Rational
@findex Rational
@noindent
Syntax:
@smallexample @c ada
pragma Rational;
@end smallexample
@noindent
This pragma is considered obsolescent, but is retained for
compatibility purposes. It is equivalent to:
@smallexample @c ada
pragma Profile (Rational);
@end smallexample
@node Pragma Ravenscar
@unnumberedsec Pragma Ravenscar
@findex Pragma Ravenscar

4
gcc/ada/par-ch3.adb
View File

@ -652,6 +652,10 @@ package body Ch3 is
Typedef_Node := P_Record_Definition;
Set_Limited_Present (Typedef_Node, True);
End_Labl := Make_Identifier (Token_Ptr, Chars (Ident_Node));
Set_Comes_From_Source (End_Labl, False);
Set_End_Label (Typedef_Node, End_Labl);
-- Ada 2005 (AI-251): LIMITED INTERFACE

4
gcc/ada/sinfo.ads
View File

@ -2052,7 +2052,9 @@ package Sinfo is
-- and range checks in cases where the generated code knows that the
-- value being assigned is in range and satisfies any predicate. Also
-- can be set in N_Object_Declaration nodes, to similarly suppress any
-- checks on the initializing value.
-- checks on the initializing value. In assignment statements it also
-- suppresses access checks in the generated code for out- and in-out
-- parameters in entry calls.
-- Suppress_Loop_Warnings (Flag17-Sem)
-- Used in N_Loop_Statement node to indicate that warnings within the

6
gcc/ada/tbuild.adb
View File

@ -434,7 +434,7 @@ package body Tbuild is
Reason : RT_Exception_Code) return Node_Id
is
begin
pragma Assert (Kind (Reason) = CE_Reason);
pragma Assert (Rkind (Reason) = CE_Reason);
return
Make_Raise_Constraint_Error (Sloc,
Condition => Condition,
@ -451,7 +451,7 @@ package body Tbuild is
Reason : RT_Exception_Code) return Node_Id
is
begin
pragma Assert (Kind (Reason) = PE_Reason);
pragma Assert (Rkind (Reason) = PE_Reason);
return
Make_Raise_Program_Error (Sloc,
Condition => Condition,
@ -468,7 +468,7 @@ package body Tbuild is
Reason : RT_Exception_Code) return Node_Id
is
begin
pragma Assert (Kind (Reason) = SE_Reason);
pragma Assert (Rkind (Reason) = SE_Reason);
return
Make_Raise_Storage_Error (Sloc,
Condition => Condition,

83
gcc/ada/types.ads
View File

@ -855,17 +855,18 @@ package Types is
CE_Length_Check_Failed, -- 07
CE_Null_Exception_Id, -- 08
CE_Null_Not_Allowed, -- 09
CE_Overflow_Check_Failed, -- 10
CE_Partition_Check_Failed, -- 11
CE_Range_Check_Failed, -- 12
CE_Tag_Check_Failed, -- 13
PE_Access_Before_Elaboration, -- 14
PE_Accessibility_Check_Failed, -- 15
PE_Address_Of_Intrinsic, -- 16
PE_Aliased_Parameters, -- 17
PE_All_Guards_Closed, -- 18
PE_Bad_Predicated_Generic_Type, -- 19
PE_Current_Task_In_Entry_Body, -- 20
PE_Duplicated_Entry_Address, -- 21
PE_Explicit_Raise, -- 22
@ -876,60 +877,60 @@ package Types is
PE_Overlaid_Controlled_Object, -- 27
PE_Potentially_Blocking_Operation, -- 28
PE_Stubbed_Subprogram_Called, -- 29
PE_Unchecked_Union_Restriction, -- 30
PE_Non_Transportable_Actual, -- 31
SE_Empty_Storage_Pool, -- 32
SE_Explicit_Raise, -- 33
SE_Infinite_Recursion, -- 34
SE_Object_Too_Large, -- 35
PE_Stream_Operation_Not_Allowed); -- 36
Last_Reason_Code : constant := 36;
-- Last reason code
type Reason_Kind is (CE_Reason, PE_Reason, SE_Reason);
-- Categorization of reason codes by exception raised
Kind : array (RT_Exception_Code range <>) of Reason_Kind :=
(CE_Access_Check_Failed => CE_Reason,
CE_Access_Parameter_Is_Null => CE_Reason,
CE_Discriminant_Check_Failed => CE_Reason,
CE_Divide_By_Zero => CE_Reason,
CE_Explicit_Raise => CE_Reason,
CE_Index_Check_Failed => CE_Reason,
CE_Invalid_Data => CE_Reason,
CE_Length_Check_Failed => CE_Reason,
CE_Null_Exception_Id => CE_Reason,
CE_Null_Not_Allowed => CE_Reason,
CE_Overflow_Check_Failed => CE_Reason,
CE_Partition_Check_Failed => CE_Reason,
CE_Range_Check_Failed => CE_Reason,
CE_Tag_Check_Failed => CE_Reason,
Rkind : array (RT_Exception_Code range <>) of Reason_Kind :=
(CE_Access_Check_Failed => CE_Reason,
CE_Access_Parameter_Is_Null => CE_Reason,
CE_Discriminant_Check_Failed => CE_Reason,
CE_Divide_By_Zero => CE_Reason,
CE_Explicit_Raise => CE_Reason,
CE_Index_Check_Failed => CE_Reason,
CE_Invalid_Data => CE_Reason,
CE_Length_Check_Failed => CE_Reason,
CE_Null_Exception_Id => CE_Reason,
CE_Null_Not_Allowed => CE_Reason,
CE_Overflow_Check_Failed => CE_Reason,
CE_Partition_Check_Failed => CE_Reason,
CE_Range_Check_Failed => CE_Reason,
CE_Tag_Check_Failed => CE_Reason,
PE_Access_Before_Elaboration => PE_Reason,
PE_Accessibility_Check_Failed => PE_Reason,
PE_Address_Of_Intrinsic => PE_Reason,
PE_Aliased_Parameters => PE_Reason,
PE_All_Guards_Closed => PE_Reason,
PE_Bad_Predicated_Generic_Type => PE_Reason,
PE_Current_Task_In_Entry_Body => PE_Reason,
PE_Duplicated_Entry_Address => PE_Reason,
PE_Explicit_Raise => PE_Reason,
PE_Finalize_Raised_Exception => PE_Reason,
PE_Implicit_Return => PE_Reason,
PE_Misaligned_Address_Value => PE_Reason,
PE_Missing_Return => PE_Reason,
PE_Overlaid_Controlled_Object => PE_Reason,
PE_Potentially_Blocking_Operation => PE_Reason,
PE_Stubbed_Subprogram_Called => PE_Reason,
PE_Unchecked_Union_Restriction => PE_Reason,
PE_Non_Transportable_Actual => PE_Reason,
PE_Stream_Operation_Not_Allowed => PE_Reason,
PE_Access_Before_Elaboration => PE_Reason,
PE_Accessibility_Check_Failed => PE_Reason,
PE_Address_Of_Intrinsic => PE_Reason,
PE_Aliased_Parameters => PE_Reason,
PE_All_Guards_Closed => PE_Reason,
PE_Bad_Predicated_Generic_Type => PE_Reason,
PE_Current_Task_In_Entry_Body => PE_Reason,
PE_Duplicated_Entry_Address => PE_Reason,
PE_Explicit_Raise => PE_Reason,
PE_Finalize_Raised_Exception => PE_Reason,
PE_Implicit_Return => PE_Reason,
PE_Misaligned_Address_Value => PE_Reason,
PE_Missing_Return => PE_Reason,
PE_Overlaid_Controlled_Object => PE_Reason,
PE_Potentially_Blocking_Operation => PE_Reason,
PE_Stubbed_Subprogram_Called => PE_Reason,
PE_Unchecked_Union_Restriction => PE_Reason,
PE_Non_Transportable_Actual => PE_Reason,
PE_Stream_Operation_Not_Allowed => PE_Reason,
SE_Empty_Storage_Pool => SE_Reason,
SE_Explicit_Raise => SE_Reason,
SE_Infinite_Recursion => SE_Reason,
SE_Object_Too_Large => SE_Reason);
SE_Empty_Storage_Pool => SE_Reason,
SE_Explicit_Raise => SE_Reason,
SE_Infinite_Recursion => SE_Reason,
SE_Object_Too_Large => SE_Reason);
end Types;