diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 24 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 68 | ||||
| -rw-r--r-- | gcc/ada/gnat1drv.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 23 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 2 |
6 files changed, 104 insertions, 18 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f0f8471..aec17d6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2014-01-20 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_ch4.adb (Expand_N_Slice): Relocate some variables and + constants to the "Local variables" area. Add new constant D. Add + new variables Drange and Index_Typ. Rename Pfx to Rep and Ptp + to Pref_Typ and update all occurrences. Add circuitry to extract + the discrete_range and the index type and build a range check. + +2014-01-20 Arnaud Charlet <charlet@adacore.com> + + * gnat1drv.adb (Adjust_Global_Switches): Enable + Treat_Categorization_Errors_As_Warnings when Relaxed_RM_Semantics + is set. + +2014-01-20 Thomas Quinot <quinot@adacore.com> + + * sem_ch5.adb, sem_ch4.adb: Minor reformatting. + +2014-01-20 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_ch13.adb (Analyze_Aspect_Specifications): + When aspect SPARK_Mode appears on a package body, insert the + generated pragma at the top of the body declarations. + 2014-01-20 Robert Dewar <dewar@adacore.com> * sem_aggr.adb, exp_prag.adb, sem_aux.adb, sinfo.ads, sem_ch10.adb, diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 32d430b..c8cded1 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -9329,10 +9329,8 @@ package body Exp_Ch4 is -------------------- procedure Expand_N_Slice (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Typ : constant Entity_Id := Etype (N); - Pfx : constant Node_Id := Prefix (N); - Ptp : Entity_Id := Etype (Pfx); + Loc : constant Source_Ptr := Sloc (N); + Typ : constant Entity_Id := Etype (N); function Is_Procedure_Actual (N : Node_Id) return Boolean; -- Check whether the argument is an actual for a procedure call, in @@ -9390,8 +9388,8 @@ package body Exp_Ch4 is ------------------------------ procedure Make_Temporary_For_Slice is - Decl : Node_Id; Ent : constant Entity_Id := Make_Temporary (Loc, 'T', N); + Decl : Node_Id; begin Decl := @@ -9404,38 +9402,80 @@ package body Exp_Ch4 is Insert_Actions (N, New_List ( Decl, Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Ent, Loc), + Name => New_Occurrence_Of (Ent, Loc), Expression => Relocate_Node (N)))); Rewrite (N, New_Occurrence_Of (Ent, Loc)); Analyze_And_Resolve (N, Typ); end Make_Temporary_For_Slice; + -- Local variables + + D : constant Node_Id := Discrete_Range (N); + Pref : constant Node_Id := Prefix (N); + Pref_Typ : Entity_Id := Etype (Pref); + Drange : Node_Id; + Index_Typ : Entity_Id; + -- Start of processing for Expand_N_Slice begin -- Special handling for access types - if Is_Access_Type (Ptp) then + if Is_Access_Type (Pref_Typ) then + Pref_Typ := Designated_Type (Pref_Typ); - Ptp := Designated_Type (Ptp); - - Rewrite (Pfx, + Rewrite (Pref, Make_Explicit_Dereference (Sloc (N), - Prefix => Relocate_Node (Pfx))); + Prefix => Relocate_Node (Pref))); - Analyze_And_Resolve (Pfx, Ptp); + Analyze_And_Resolve (Pref, Pref_Typ); end if; -- Ada 2005 (AI-318-02): If the prefix is a call to a build-in-place -- function, then additional actuals must be passed. if Ada_Version >= Ada_2005 - and then Is_Build_In_Place_Function_Call (Pfx) + and then Is_Build_In_Place_Function_Call (Pref) then - Make_Build_In_Place_Call_In_Anonymous_Context (Pfx); + Make_Build_In_Place_Call_In_Anonymous_Context (Pref); end if; + -- Find the range of the discrete_range. For ranges that do not appear + -- in the slice itself, we make a shallow copy and inherit the source + -- location and the parent field from the discrete_range. This ensures + -- that the range check is inserted relative to the slice and that the + -- runtime exception poins to the proper construct. + + if Nkind (D) = N_Range then + Drange := D; + + elsif Nkind_In (D, N_Expanded_Name, N_Identifier) then + Drange := New_Copy (Scalar_Range (Entity (D))); + Set_Etype (Drange, Entity (D)); + Set_Parent (Drange, Parent (D)); + Set_Sloc (Drange, Sloc (D)); + + else pragma Assert (Nkind (D) = N_Subtype_Indication); + Drange := New_Copy (Range_Expression (Constraint (D))); + Set_Etype (Drange, Etype (D)); + Set_Parent (Drange, Parent (D)); + Set_Sloc (Drange, Sloc (D)); + end if; + + -- Find the type of the array index + + if Ekind (Pref_Typ) = E_String_Literal_Subtype then + Index_Typ := Etype (String_Literal_Low_Bound (Pref_Typ)); + else + Index_Typ := Etype (First_Index (Pref_Typ)); + end if; + + -- Add a runtime check to test the compatibility between the array range + -- and the discrete_range. + + Apply_Range_Check (Drange, Index_Typ); + -- The remaining case to be handled is packed slices. We can leave -- packed slices as they are in the following situations: diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index d380468..8eb9173 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -291,6 +291,7 @@ procedure Gnat1drv is if Relaxed_RM_Semantics then Overriding_Renamings := True; + Treat_Categorization_Errors_As_Warnings := True; end if; -- Set switches for formal verification mode diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index fa5ed8d..67dfd8d 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2132,13 +2132,34 @@ package body Sem_Ch13 is -- SPARK_Mode - when Aspect_SPARK_Mode => + when Aspect_SPARK_Mode => SPARK_Mode : declare + Decls : List_Id; + + begin Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), Pragma_Name => Name_SPARK_Mode); + -- When the aspect appears on a package body, insert the + -- generated pragma at the top of the body declarations to + -- emulate the behavior of a source pragma. + + if Nkind (N) = N_Package_Body then + Decorate_Delayed_Aspect_And_Pragma (Aspect, Aitem); + Decls := Declarations (N); + + if No (Decls) then + Decls := New_List; + Set_Declarations (N, Decls); + end if; + + Prepend_To (Decls, Aitem); + goto Continue; + end if; + end SPARK_Mode; + -- Refined_Depends -- Aspect Refined_Depends must be delayed because it can diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index d458192..457b581 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6839,8 +6839,8 @@ package body Sem_Ch4 is if No (Func_Name) then - -- The prefix itself may be an indexing of a container - -- rewrite as such and re-analyze. + -- The prefix itself may be an indexing of a container: rewrite + -- as such and re-analyze. if Has_Implicit_Dereference (Etype (Prefix)) then Build_Explicit_Dereference diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index b0d59e3..bb66856 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -187,7 +187,7 @@ package body Sem_Ch5 is end Diagnose_Non_Variable_Lhs; -------------- - -- Kill_LHS -- + -- Kill_Lhs -- -------------- procedure Kill_Lhs is |