From: Arnaud Charlet Date: Wed, 30 Jul 2014 12:34:21 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=e5c4e2bc5bdc3100399604a462c2d94aaee5ba8e;p=gcc.git [multiple changes] 2014-07-30 Jose Ruiz * s-tarest.adb, s-tarest.ads: Fix comments. 2014-07-30 Robert Dewar * exp_attr.adb, checks.adb, sem_util.adb, sem_util.ads, sem_attr.adb: Change No_Scalar_Parts predicate to Scalar_Part_Present and invert sense of test. This avoids the "not No_xxx" situation which is always ugly. 2014-07-30 Ed Schonberg * inline.adb (Expand_Inlined_Call): When generating code for an internal subprogram the expansion uses the location of the call, so that gdb can skip over it. In GNATprove mode we want to preserve slocs of original subprogram when expanding an inlined call, to obtain better warnings, even though subprogram appears not to come from source if it is the inlining of a subprogram body without a previous spec. 2014-07-30 Eric Botcazou * exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Reject array types with atomic components. 2014-07-30 Thomas Quinot * Make-generated.in: Remove now unnecessary targets after s-oscons reorg. 2014-07-30 Yannick Moy * sem_res.adb (Resolve_Call): Use ultimate alias of callee when available. 2014-07-30 Ed Schonberg * sem_ch6.adb (Analyze_Expression_Function): To check whether an expression function is a completion, use the specification of the previous declaration, not its entity, which may be internally generated in an inlined context. From-SVN: r213254 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 897057909ce..4b379a2c8f9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,46 @@ +2014-07-30 Jose Ruiz + + * s-tarest.adb, s-tarest.ads: Fix comments. + +2014-07-30 Robert Dewar + + * exp_attr.adb, checks.adb, sem_util.adb, sem_util.ads, sem_attr.adb: + Change No_Scalar_Parts predicate to Scalar_Part_Present and + invert sense of test. This avoids the "not No_xxx" situation + which is always ugly. + +2014-07-30 Ed Schonberg + + * inline.adb (Expand_Inlined_Call): When generating code for + an internal subprogram the expansion uses the location of the + call, so that gdb can skip over it. In GNATprove mode we want to + preserve slocs of original subprogram when expanding an inlined + call, to obtain better warnings, even though subprogram appears + not to come from source if it is the inlining of a subprogram + body without a previous spec. + +2014-07-30 Eric Botcazou + + * exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Reject array + types with atomic components. + +2014-07-30 Thomas Quinot + + * Make-generated.in: Remove now unnecessary targets after s-oscons + reorg. + +2014-07-30 Yannick Moy + + * sem_res.adb (Resolve_Call): Use ultimate alias + of callee when available. + +2014-07-30 Ed Schonberg + + * sem_ch6.adb (Analyze_Expression_Function): To check whether + an expression function is a completion, use the specification of + the previous declaration, not its entity, which may be internally + generated in an inlined context. + 2014-07-30 Doug Rupp * adaint.c (__gnat_tmp_name) [__ANDROID__]: Default to putting diff --git a/gcc/ada/Make-generated.in b/gcc/ada/Make-generated.in index 17200c77861..c8482876f2e 100644 --- a/gcc/ada/Make-generated.in +++ b/gcc/ada/Make-generated.in @@ -66,12 +66,6 @@ $(ADA_GEN_SUBDIR)/stamp-nmake: $(ADA_GEN_SUBDIR)/sinfo.ads $(ADA_GEN_SUBDIR)/nma $(MOVE_IF_CHANGE) $(ADA_GEN_SUBDIR)/bldtools/nmake/nmake.adb $(ADA_GEN_SUBDIR)/nmake.adb touch $(ADA_GEN_SUBDIR)/stamp-nmake -$(ADA_GEN_SUBDIR)/bldtools/oscons/xoscons : $(ADA_GEN_SUBDIR)/xoscons.adb $(ADA_GEN_SUBDIR)/xutil.ads $(ADA_GEN_SUBDIR)/xutil.adb - -$(MKDIR) $(ADA_GEN_SUBDIR)/bldtools/oscons - $(RM) $(addprefix $(ADA_GEN_SUBDIR)/bldtools/oscons/,$(notdir $^)) - $(CP) $^ $(ADA_GEN_SUBDIR)/bldtools/oscons - cd $(ADA_GEN_SUBDIR)/bldtools/oscons ; gnatmake -q xoscons - $(ADA_GEN_SUBDIR)/sdefault.adb: $(ADA_GEN_SUBDIR)/stamp-sdefault ; @true $(ADA_GEN_SUBDIR)/stamp-sdefault : $(srcdir)/version.c Makefile $(ECHO) "pragma Style_Checks (Off);" >tmp-sdefault.adb diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index b0538d8fd68..d9a6c9d2537 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -2402,13 +2402,18 @@ package body Checks is Nam : Name_Id; begin - -- Pick the proper version of 'Valid depending on the type of the - -- context. If the context is not eligible for such a check, return. + -- For scalars, generate 'Valid test if Is_Scalar_Type (Typ) then Nam := Name_Valid; - elsif not No_Scalar_Parts (Typ) then + + -- For any non-scalar with scalar parts, generate 'Valid_Scalars test + + elsif Scalar_Part_Present (Typ) then Nam := Name_Valid_Scalars; + + -- No test needed for other cases (no scalars to test) + else return; end if; diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 60373568d34..22b5e26f773 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4006,11 +4006,13 @@ package body Exp_Aggr is -- 1. N consists of a single OTHERS choice, possibly recursively - -- 2. The component type is discrete + -- 2. The array type has no atomic components - -- 3. The component size is a multiple of Storage_Unit + -- 3. The component type is discrete - -- 4. The component size is exactly Storage_Unit or the expression is + -- 4. The component size is a multiple of Storage_Unit + + -- 5. The component size is exactly Storage_Unit or the expression is -- an integer whose unsigned value is the binary concatenation of -- K times its remainder modulo 2**Storage_Unit. @@ -4035,6 +4037,10 @@ package body Exp_Aggr is return False; end if; + if Has_Atomic_Components (Ctyp) then + return False; + end if; + Expr := Expression (First (Component_Associations (Expr))); for J in 1 .. Number_Dimensions (Ctyp) - 1 loop @@ -4048,6 +4054,9 @@ package body Exp_Aggr is end loop; Ctyp := Component_Type (Ctyp); + if Is_Atomic (Ctyp) then + return False; + end if; end loop; if not Is_Discrete_Type (Ctyp) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index b24c3d14720..f8cfd4ca93a 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -6358,7 +6358,7 @@ package body Exp_Attr is -- We only do this for arrays whose component type needs checking elsif Is_Array_Type (Ftyp) - and then not No_Scalar_Parts (Component_Type (Ftyp)) + and then Scalar_Part_Present (Component_Type (Ftyp)) then Rewrite (N, Make_Function_Call (Loc, @@ -6372,7 +6372,7 @@ package body Exp_Attr is -- Valid_Scalars as appropriate to all relevant components. elsif (Is_Record_Type (Ptyp) or else Has_Discriminants (Ptyp)) - and then not No_Scalar_Parts (Ptyp) + and then Scalar_Part_Present (Ptyp) then declare C : Entity_Id; @@ -6383,7 +6383,7 @@ package body Exp_Attr is X := New_Occurrence_Of (Standard_True, Loc); C := First_Component_Or_Discriminant (Ptyp); while Present (C) loop - if No_Scalar_Parts (Etype (C)) then + if not Scalar_Part_Present (Etype (C)) then goto Continue; elsif Is_Scalar_Type (Etype (C)) then A := Name_Valid; diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index e5ec8d5df04..57a663d6014 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -2955,7 +2955,8 @@ package body Inline is -- expansion is skipped by the "next" command in gdb. -- Same processing for a subprogram in a predefined file, e.g. -- Ada.Tags. If Debug_Generated_Code is true, suppress this change to - -- simplify our own development. + -- simplify our own development. Same in in GNATprove mode, to ensure + -- that warnings and diagnostics point to the proper location. procedure Reset_Dispatching_Calls (N : Node_Id); -- In subtree N search for occurrences of dispatching calls that use the @@ -3932,7 +3933,10 @@ package body Inline is Replace_Formals (Blk); Set_Parent (Blk, N); - if not Comes_From_Source (Subp) or else Is_Predef then + if GNATprove_Mode then + null; + + elsif not Comes_From_Source (Subp) or else Is_Predef then Reset_Slocs (Blk); end if; diff --git a/gcc/ada/s-tarest.adb b/gcc/ada/s-tarest.adb index 22343c660e2..c746ab9e17c 100644 --- a/gcc/ada/s-tarest.adb +++ b/gcc/ada/s-tarest.adb @@ -126,7 +126,7 @@ package body System.Tasking.Restricted.Stages is Elaborated : Access_Boolean; Task_Image : String; Created_Task : Task_Id); - -- Code shared between Create_Restricted_Task_Concurrent and + -- Code shared between Create_Restricted_Task (the concurrent version) and -- Create_Restricted_Task_Sequential. See comment of the former in the -- specification of this package. diff --git a/gcc/ada/s-tarest.ads b/gcc/ada/s-tarest.ads index 6313be626ab..90c1f2cc134 100644 --- a/gcc/ada/s-tarest.ads +++ b/gcc/ada/s-tarest.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -196,10 +196,9 @@ package System.Tasking.Restricted.Stages is -- This must be called to create a new task, when the sequential partition -- elaboration policy is used. -- - -- The parameters are the same as Create_Restricted_Task_Concurrent, - -- except there is no Chain parameter (for the activation chain), as there - -- is only one global activation chain, which is declared in the body of - -- this package. + -- The parameters are the same as Create_Restricted_Task except there is + -- no Chain parameter (for the activation chain), as there is only one + -- global activation chain, which is declared in the body of this package. procedure Activate_Restricted_Tasks (Chain_Access : Activation_Chain_Access); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index f9493faaf03..bc4f1e21aac 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -6590,7 +6590,7 @@ package body Sem_Attr is Check_E0; Check_Object_Reference (P); - if No_Scalar_Parts (P_Type) then + if not Scalar_Part_Present (P_Type) then Error_Attr_P ("??attribute % always True, no scalars to check"); end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 41ddca237f3..a7cfce25a7f 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -353,7 +353,12 @@ package body Sem_Ch6 is Analyze (New_Body); Set_Is_Inlined (Prev); - elsif Present (Prev) and then Comes_From_Source (Prev) then + -- If the expression function is a completion, the previous declaration + -- must come from source. We know already that appears in the current + -- scope. The entity itself may be internally created if within a body + -- to be inlined. + + elsif Present (Prev) and then Comes_From_Source (Parent (Prev)) then Set_Has_Completion (Prev, False); -- An expression function that is a completion freezes the diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index dab6c8f6748..10edd1a77e9 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6209,11 +6209,22 @@ package body Sem_Res is if GNATprove_Mode and then Is_Overloadable (Nam) - and then Nkind (Unit_Declaration_Node (Nam)) = N_Subprogram_Declaration - and then Present (Body_To_Inline (Unit_Declaration_Node (Nam))) and then SPARK_Mode = On then - Expand_Inlined_Call (N, Nam, Nam); + -- Retrieve the body to inline from the ultimate alias of Nam, if + -- there is one, otherwise calls that should be inlined end up not + -- being inlined. + + declare + Nam_Alias : constant Entity_Id := Ultimate_Alias (Nam); + Decl : constant Node_Id := Unit_Declaration_Node (Nam_Alias); + begin + if Nkind (Decl) = N_Subprogram_Declaration + and then Present (Body_To_Inline (Decl)) + then + Expand_Inlined_Call (N, Nam_Alias, Nam); + end if; + end; end if; Warn_On_Overlapping_Actuals (Nam, N); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 7043b79bd6c..916942a6bd0 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -13818,34 +13818,6 @@ package body Sem_Util is Actual_Id := Next_Actual (Actual_Id); end Next_Actual; - --------------------- - -- No_Scalar_Parts -- - --------------------- - - function No_Scalar_Parts (T : Entity_Id) return Boolean is - C : Entity_Id; - - begin - if Is_Scalar_Type (T) then - return False; - - elsif Is_Array_Type (T) then - return No_Scalar_Parts (Component_Type (T)); - - elsif Is_Record_Type (T) or else Has_Discriminants (T) then - C := First_Component_Or_Discriminant (T); - while Present (C) loop - if not No_Scalar_Parts (Etype (C)) then - return False; - else - Next_Component_Or_Discriminant (C); - end if; - end loop; - end if; - - return True; - end No_Scalar_Parts; - ----------------------- -- Normalize_Actuals -- ----------------------- @@ -15805,6 +15777,34 @@ package body Sem_Util is end if; end Save_SPARK_Mode_And_Set; + ------------------------- + -- Scalar_Part_Present -- + ------------------------- + + function Scalar_Part_Present (T : Entity_Id) return Boolean is + C : Entity_Id; + + begin + if Is_Scalar_Type (T) then + return True; + + elsif Is_Array_Type (T) then + return Scalar_Part_Present (Component_Type (T)); + + elsif Is_Record_Type (T) or else Has_Discriminants (T) then + C := First_Component_Or_Discriminant (T); + while Present (C) loop + if Scalar_Part_Present (Etype (C)) then + return True; + else + Next_Component_Or_Discriminant (C); + end if; + end loop; + end if; + + return False; + end Scalar_Part_Present; + ------------------------ -- Scope_Is_Transient -- ------------------------ diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 970b2bafa77..d9bf0bc0b75 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1582,11 +1582,6 @@ package Sem_Util is -- Note that the result produced is always an expression, not a parameter -- association node, even if named notation was used. - function No_Scalar_Parts (T : Entity_Id) return Boolean; - -- Tests if type T can be determined at compile time to have no scalar - -- parts in the sense of the Valid_Scalars attribute. Returns True if - -- this is the case, meaning that the result of Valid_Scalars is True. - procedure Normalize_Actuals (N : Node_Id; S : Entity_Id; @@ -1774,6 +1769,12 @@ package Sem_Util is -- (if any) of a package or a subprogram denoted by Context. This routine -- must be used in tandem with Restore_SPARK_Mode. + function Scalar_Part_Present (T : Entity_Id) return Boolean; + -- Tests if type T can be determined at compile time to have at least one + -- scalar part in the sense of the Valid_Scalars attribute. Returns True if + -- this is the case, and False if no scalar parts are present (meaning that + -- the result of Valid_Scalars applied to T is always vacuously True). + function Scope_Within_Or_Same (Scope1, Scope2 : Entity_Id) return Boolean; -- Determines if the entity Scope1 is the same as Scope2, or if it is -- inside it, where both entities represent scopes. Note that scopes