Skip to content

R
riscv-gcc-1
Commit deeb1604 by Arnaud Charlet
Options

[multiple changes] 

2010-10-21  Vincent Celier  <celier@adacore.com>

	* vms_data.ads: Add new qualifiers /SRC_INFO= and
	/UNCHECKED_SHARED_LIB_IMPORTS for GNAT COMPILE.
	Correct qualifier /SRC_INFO= for GNAT MAKE

2010-10-21  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Flatten): An association for a subtype may be an
	expanded name.
	(Safe_Left_Hand_Side): An unchecked conversion is part of a safe
	left-hand side if the expression is.
	(Is_Safe_Index): new predicate
	* exp_ch3.adb (Expand_Freeze_Enumeration_Type): Indicate that the
	generated Rep_To_Pos function is a Pure_Function.

2010-10-21  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Document Invariant pragma.

From-SVN: r165759
parent 51625339
Showing with 144 additions and 26 deletions
gcc/ada/ChangeLog
2010-10-21 Vincent Celier <celier@adacore.com>
* vms_data.ads: Add new qualifiers /SRC_INFO= and
/UNCHECKED_SHARED_LIB_IMPORTS for GNAT COMPILE.
Correct qualifier /SRC_INFO= for GNAT MAKE
2010-10-21 Ed Schonberg <schonberg@adacore.com>
* exp_aggr.adb (Flatten): An association for a subtype may be an
expanded name.
(Safe_Left_Hand_Side): An unchecked conversion is part of a safe
left-hand side if the expression is.
(Is_Safe_Index): new predicate
* exp_ch3.adb (Expand_Freeze_Enumeration_Type): Indicate that the
generated Rep_To_Pos function is a Pure_Function.
2010-10-21 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Document Invariant pragma.
2010-10-21 Javier Miranda <miranda@adacore.com>
* exp_ch5.adb: Update comment.
......
gcc/ada/exp_aggr.adb
......@@ -227,7 +227,7 @@ package body Exp_Aggr is
Index : Node_Id;
Into : Node_Id;
Scalar_Comp : Boolean;
Indices : List_Id := No_List;
Indexes : List_Id := No_List;
Flist : Node_Id := Empty) return List_Id;
-- This recursive routine returns a list of statements containing the
-- loops and assignments that are needed for the expansion of the array
......@@ -244,7 +244,7 @@ package body Exp_Aggr is
--
-- Scalar_Comp is True if the component type of the aggregate is scalar.
--
-- Indices is the current list of expressions used to index the
-- Indexes is the current list of expressions used to index the
-- object we are writing into.
--
-- Flist is an expression representing the finalization list on which
......@@ -701,7 +701,7 @@ package body Exp_Aggr is
Index : Node_Id;
Into : Node_Id;
Scalar_Comp : Boolean;
Indices : List_Id := No_List;
Indexes : List_Id := No_List;
Flist : Node_Id := Empty) return List_Id
is
Loc : constant Source_Ptr := Sloc (N);
......@@ -728,7 +728,7 @@ package body Exp_Aggr is
-- N to Build_Loop contains no sub-aggregates, then this function
-- returns the assignment statement:
--
-- Into (Indices, Ind) := Expr;
-- Into (Indexes, Ind) := Expr;
--
-- Otherwise we call Build_Code recursively
--
......@@ -741,7 +741,7 @@ package body Exp_Aggr is
-- This routine returns the for loop statement
--
-- for J in Index_Base'(L) .. Index_Base'(H) loop
-- Into (Indices, J) := Expr;
-- Into (Indexes, J) := Expr;
-- end loop;
--
-- Otherwise we call Build_Code recursively.
......@@ -756,7 +756,7 @@ package body Exp_Aggr is
-- J : Index_Base := L;
-- while J < H loop
-- J := Index_Base'Succ (J);
-- Into (Indices, J) := Expr;
-- Into (Indexes, J) := Expr;
-- end loop;
--
-- Otherwise we call Build_Code recursively
......@@ -942,7 +942,7 @@ package body Exp_Aggr is
F : Entity_Id;
A : Node_Id;
New_Indices : List_Id;
New_Indexes : List_Id;
Indexed_Comp : Node_Id;
Expr_Q : Node_Id;
Comp_Type : Entity_Id := Empty;
......@@ -982,13 +982,13 @@ package body Exp_Aggr is
-- Start of processing for Gen_Assign
begin
if No (Indices) then
New_Indices := New_List;
if No (Indexes) then
New_Indexes := New_List;
else
New_Indices := New_Copy_List_Tree (Indices);
New_Indexes := New_Copy_List_Tree (Indexes);
end if;
Append_To (New_Indices, Ind);
Append_To (New_Indexes, Ind);
if Present (Flist) then
F := New_Copy_Tree (Flist);
......@@ -1014,7 +1014,7 @@ package body Exp_Aggr is
Index => Next_Index (Index),
Into => Into,
Scalar_Comp => Scalar_Comp,
Indices => New_Indices,
Indexes => New_Indexes,
Flist => F));
end if;
......@@ -1024,7 +1024,7 @@ package body Exp_Aggr is
Checks_Off
(Make_Indexed_Component (Loc,
Prefix => New_Copy_Tree (Into),
Expressions => New_Indices));
Expressions => New_Indexes));
Set_Assignment_OK (Indexed_Comp);
......@@ -1045,7 +1045,7 @@ package body Exp_Aggr is
Comp_Type := Component_Type (Etype (N));
pragma Assert (Comp_Type = Ctype); -- AI-287
elsif Present (Next (First (New_Indices))) then
elsif Present (Next (First (New_Indexes))) then
-- Ada 2005 (AI-287): Do nothing in case of default initialized
-- component because we have received the component type in
......@@ -3946,9 +3946,9 @@ package body Exp_Aggr is
exit Component_Loop;
-- Case of a subtype mark
-- Case of a subtype mark, identifier or expanded name
elsif Nkind (Choice) = N_Identifier
elsif Is_Entity_Name (Choice)
and then Is_Type (Entity (Choice))
then
Lo := Type_Low_Bound (Etype (Choice));
......@@ -4217,7 +4217,7 @@ package body Exp_Aggr is
Comp : Node_Id;
Decl : Node_Id;
Typ : constant Entity_Id := Etype (N);
Indices : constant List_Id := New_List;
Indexes : constant List_Id := New_List;
Num : Int;
Sub_Agg : Node_Id;
......@@ -4239,7 +4239,7 @@ package body Exp_Aggr is
Next (Comp);
end loop;
Append_To (Indices,
Append_To (Indexes,
Make_Range (Loc,
Low_Bound => Make_Integer_Literal (Loc, 1),
High_Bound => Make_Integer_Literal (Loc, Num)));
......@@ -4255,7 +4255,7 @@ package body Exp_Aggr is
Make_Range (Loc,
Low_Bound => Aggr_Low (D),
High_Bound => Aggr_High (D)),
Indices);
Indexes);
end loop;
end if;
......@@ -4264,10 +4264,10 @@ package body Exp_Aggr is
Defining_Identifier => Agg_Type,
Type_Definition =>
Make_Constrained_Array_Definition (Loc,
Discrete_Subtype_Definitions => Indices,
Component_Definition =>
Discrete_Subtype_Definitions => Indexes,
Component_Definition =>
Make_Component_Definition (Loc,
Aliased_Present => False,
Aliased_Present => False,
Subtype_Indication =>
New_Occurrence_Of (Component_Type (Typ), Loc))));
......@@ -4940,6 +4940,41 @@ package body Exp_Aggr is
-------------------------
function Safe_Left_Hand_Side (N : Node_Id) return Boolean is
function Is_Safe_Index (Indx : Node_Id) return Boolean;
-- If the left-hand side includes an indexed component, check that
-- the indexes are free of side-effect.
-------------------
-- Is_Safe_Index --
-------------------
function Is_Safe_Index (Indx : Node_Id) return Boolean is
begin
if Is_Entity_Name (Indx) then
return True;
elsif Nkind (Indx) = N_Integer_Literal then
return True;
elsif Nkind (Indx) = N_Function_Call
and then Is_Entity_Name (Name (Indx))
and then
Has_Pragma_Pure_Function (Entity (Name (Indx)))
then
return True;
elsif Nkind (Indx) = N_Type_Conversion
and then Is_Safe_Index (Expression (Indx))
then
return True;
else
return False;
end if;
end Is_Safe_Index;
-- Start of processing for Safe_Left_Hand_Side
begin
if Is_Entity_Name (N) then
return True;
......@@ -4952,10 +4987,13 @@ package body Exp_Aggr is
elsif Nkind (N) = N_Indexed_Component
and then Safe_Left_Hand_Side (Prefix (N))
and then
(Is_Entity_Name (First (Expressions (N)))
or else Nkind (First (Expressions (N))) = N_Integer_Literal)
Is_Safe_Index (First (Expressions (N)))
then
return True;
elsif Nkind (N) = N_Unchecked_Type_Conversion then
return Safe_Left_Hand_Side (Expression (N));
else
return False;
end if;
......@@ -6101,7 +6139,7 @@ package body Exp_Aggr is
Index => First_Index (Typ),
Into => Target,
Scalar_Comp => Is_Scalar_Type (Component_Type (Typ)),
Indices => No_List,
Indexes => No_List,
Flist => Flist);
end if;
end Late_Expansion;
......
gcc/ada/exp_ch3.adb
......@@ -5858,6 +5858,11 @@ package body Exp_Ch3 is
Set_TSS (Typ, Fent);
Set_Is_Pure (Fent);
-- The Pure flag will be reset is the current context is not pure.
-- For optimization purposes and constant-folding, indicate that the
-- Rep_To_Pos function can be considered free of side effects.
Set_Has_Pragma_Pure_Function (Fent);
if not Debug_Generated_Code then
Set_Debug_Info_Off (Fent);
......
gcc/ada/gnat_rm.texi
......@@ -156,6 +156,7 @@ Implementation Defined Pragmas
* Pragma Interface_Name::
* Pragma Interrupt_Handler::
* Pragma Interrupt_State::
* Pragma Invariant::
* Pragma Keep_Names::
* Pragma License::
* Pragma Link_With::
......@@ -774,6 +775,7 @@ consideration, the use of these pragmas should be minimized.
* Pragma Interface_Name::
* Pragma Interrupt_Handler::
* Pragma Interrupt_State::
* Pragma Invariant::
* Pragma Keep_Names::
* Pragma License::
* Pragma Link_With::
......@@ -3052,6 +3054,43 @@ Overriding the default state of signals used by the Ada runtime may interfere
with an application's runtime behavior in the cases of the synchronous signals,
and in the case of the signal used to implement the @code{abort} statement.
@node Pragma Invariant
@unnumberedsec Pragma Invariant
@findex Invariant
@noindent
Syntax:
@smallexample @c ada
pragma Invariant
([Entity =>] private_type_LOCAL_NAME,
[Check =>] EXPRESSION
[,[Message =>] String_Expression]);
@end smallexample
@noindent
This pragma provides exactly the same capabilities as the Invariant aspect
defined in AI05-0146-1, and in the Ada 2012 Reference Manual. The Invariant
aspect is fully implemented in Ada 2012 mode, but since it requires the use
of the aspect syntax, which is not available exception in 2012 mode, it is
not possible to use the Invariant aspect in earlier versions of Ada. However
the Invariant pragma may be used in any version of Ada.
The pragma must appear within the visible part of the package specification,
after the type to which its Entity argument appears. As with the Invariant
aspect, the Check expression is not analyzed until the end of the visible
part of the package, so it may contain forward references. The Message
argument, if present, provides the exception message used if the invariant
is violated. If no Message parameter is provided, a default message that
identifies the line on which the pragma appears is used.
It is permissible to have multiple Invariants for the same type entity, in
which case they are and'ed together. It is permissible to use this pragma
in Ada 2012 mode, but you cannot have both an invariant aspect and an
invariant pragma for the same entity.
For further details on the use of this pragma, see the Ada 2012 documentation
of the Invariant aspect.
@node Pragma Keep_Names
@unnumberedsec Pragma Keep_Names
@findex Keep_Names
......
gcc/ada/vms_data.ads
......@@ -2242,6 +2242,13 @@ package VMS_Data is
--
-- When looking for source files also look in directories specified.
S_GCC_Src_Info : aliased constant S := "/SRC_INFO=<" &
"--source-info=>";
-- /SRC_INFO=source-info-file
--
-- Specify a source info file to be read or written by the Project
-- Manager when project files are used.
S_GCC_Style : aliased constant S := "/STYLE_CHECKS=" &
"ALL_BUILTIN " &
"-gnatyy " &
......@@ -2776,6 +2783,13 @@ package VMS_Data is
-- semantic analyzer is more likely to encounter some internal fatal
-- error when given a syntactically invalid tree.
S_GCC_USL : aliased constant S := "/UNCHECKED_SHARED_LIB_IMPORTS " &
"--unchecked-shared-lib-imports";
-- /NOUNCHECKED_SHARED_LIB_IMPORTS (D)
-- /UNCHECKED_SHARED_LIB_IMPORTS
--
-- Allow shared library projects to import static library projects
S_GCC_Units : aliased constant S := "/UNITS_LIST " &
"-gnatu";
-- /NOUNITS_LIST (D)
......@@ -3551,6 +3565,7 @@ package VMS_Data is
S_GCC_RTS 'Access,
S_GCC_SCO 'Access,
S_GCC_Search 'Access,
S_GCC_Src_Info'Access,
S_GCC_Style 'Access,
S_GCC_StyleX 'Access,
S_GCC_Subdirs 'Access,
......@@ -3560,6 +3575,7 @@ package VMS_Data is
S_GCC_Trace 'Access,
S_GCC_Tree 'Access,
S_GCC_Trys 'Access,
S_GCC_USL 'Access,
S_GCC_Units 'Access,
S_GCC_Unique 'Access,
S_GCC_Upcase 'Access,
......@@ -4903,7 +4919,7 @@ package VMS_Data is
-- When looking for source files also look in the specified directories.
S_Make_Src_Info : aliased constant S := "/SRC_INFO=<" &
"--source-info-file=>";
"--source-info=>";
-- /SRC_INFO=source-info-file
--
-- Specify a source info file to be read or written by the Project
......
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