From deeb160439b8a02a5e00909ab29c25103a162d32 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 21 Oct 2010 12:05:09 +0200 Subject: [PATCH] [multiple changes] 2010-10-21 Vincent Celier * 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 * 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 * gnat_rm.texi: Document Invariant pragma. From-SVN: r165759 --- gcc/ada/ChangeLog | 20 ++++++++++ gcc/ada/exp_aggr.adb | 88 +++++++++++++++++++++++++++++++------------- gcc/ada/exp_ch3.adb | 5 +++ gcc/ada/gnat_rm.texi | 39 ++++++++++++++++++++ gcc/ada/vms_data.ads | 18 ++++++++- 5 files changed, 144 insertions(+), 26 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6677b860388..48008fdb7fe 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2010-10-21 Vincent Celier + + * 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 + + * 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 + + * gnat_rm.texi: Document Invariant pragma. + 2010-10-21 Javier Miranda * exp_ch5.adb: Update comment. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 1b1d9f5779d..83aaee67e5a 100644 --- a/gcc/ada/exp_aggr.adb +++ b/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; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 957dc0bd202..fb2732182e0 100644 --- a/gcc/ada/exp_ch3.adb +++ b/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); diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index d3353a804fa..1554b5dfad7 100644 --- a/gcc/ada/gnat_rm.texi +++ b/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 diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index cdb883e3698..03d8fbc18ec 100644 --- a/gcc/ada/vms_data.ads +++ b/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 -- 2.30.2