aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/ada/ChangeLog43
-rw-r--r--gcc/ada/Make-generated.in6
-rw-r--r--gcc/ada/checks.adb11
-rw-r--r--gcc/ada/exp_aggr.adb15
-rw-r--r--gcc/ada/exp_attr.adb6
-rw-r--r--gcc/ada/inline.adb8
-rw-r--r--gcc/ada/s-tarest.adb2
-rw-r--r--gcc/ada/s-tarest.ads9
-rw-r--r--gcc/ada/sem_attr.adb2
-rw-r--r--gcc/ada/sem_ch6.adb7
-rw-r--r--gcc/ada/sem_res.adb17
-rw-r--r--gcc/ada/sem_util.adb56
-rw-r--r--gcc/ada/sem_util.ads11
13 files changed, 132 insertions, 61 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8970579..4b379a2 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,46 @@
+2014-07-30 Jose Ruiz <ruiz@adacore.com>
+
+ * s-tarest.adb, s-tarest.ads: Fix comments.
+
+2014-07-30 Robert Dewar <dewar@adacore.com>
+
+ * 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 <schonberg@adacore.com>
+
+ * 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 <ebotcazou@adacore.com>
+
+ * exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Reject array
+ types with atomic components.
+
+2014-07-30 Thomas Quinot <quinot@adacore.com>
+
+ * Make-generated.in: Remove now unnecessary targets after s-oscons
+ reorg.
+
+2014-07-30 Yannick Moy <moy@adacore.com>
+
+ * sem_res.adb (Resolve_Call): Use ultimate alias
+ of callee when available.
+
+2014-07-30 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <rupp@adacore.com>
* adaint.c (__gnat_tmp_name) [__ANDROID__]: Default to putting
diff --git a/gcc/ada/Make-generated.in b/gcc/ada/Make-generated.in
index 17200c7..c8482876f 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 b0538d8..d9a6c9d 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 6037356..22b5e26 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 b24c3d1..f8cfd4c 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 e5ec8d5..57a663d 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 22343c6..c746ab9 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 6313be6..90c1f2c 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 f9493fa..bc4f1e2 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 41ddca2..a7cfce2 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 dab6c8f..10edd1a 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 7043b79b..916942a 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 970b2ba..d9bf0bc 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
generated by cgit v1.1 at 2025-05-30 18:12:55 +0000