Skip to content

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

[multiple changes] 

2016-06-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Is_Predicate_Static): An inherited predicate
	can be static only if it applies to a scalar type.

2016-06-22  Ed Schonberg  <schonberg@adacore.com>

	* exp_util.adb (Adjust_Result_Type): Convert operand to base
	type to prevent spurious constraint checks on subtypes of Boolean.

2016-06-22  Bob Duff  <duff@adacore.com>

	* debug.adb: Document debug switch -gnatd.o.
	* sem_elab.adb (Check_Internal_Call): Debug switch -gnatd.o
	now causes a more conservative treatment of indirect calls,
	treating P'Access as a call to P in more cases. We Can't make
	this the default, because it breaks common idioms, for example
	the soft links.
	* sem_util.adb: Add an Assert.

2016-06-22  Bob Duff  <duff@adacore.com>

	* a-cuprqu.ads, a-cuprqu.adb: Completely rewrite this package. Use
	red-black trees, which gives O(lg N) worst-case performance on
	Enqueue and Dequeue. The previous version had O(N) Enqueue in
	the worst case.

2016-06-22  Arnaud Charlet  <charlet@adacore.com>

	* sem_warn.adb: minor style fix in comment.
	* spark_xrefs.ads (Scope_Num): type refined to positive integers.
	* lib-xref-spark_specific.adb (Detect_And_Add_SPARK_Scope):
	moved into scope of Collect_SPARK_Xrefs.
	(Add_SPARK_Scope): moved into scope of Collect_SPARK_Xrefs;
	now uses Dspec and Scope_Id from Collect_SPARK_Xrefs.
	(Collect_SPARK_Xrefs): refactored to avoid retraversing the list
	of scopes.
	* sem_ch3.adb (Build_Discriminal): Set Parent of the discriminal.

From-SVN: r237687
parent 3ae6c643
Showing with 128 additions and 284 deletions
gcc/ada/ChangeLog
2016-06-22 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Is_Predicate_Static): An inherited predicate
can be static only if it applies to a scalar type.
2016-06-22 Ed Schonberg <schonberg@adacore.com>
* exp_util.adb (Adjust_Result_Type): Convert operand to base
type to prevent spurious constraint checks on subtypes of Boolean.
2016-06-22 Bob Duff <duff@adacore.com>
* debug.adb: Document debug switch -gnatd.o.
* sem_elab.adb (Check_Internal_Call): Debug switch -gnatd.o
now causes a more conservative treatment of indirect calls,
treating P'Access as a call to P in more cases. We Can't make
this the default, because it breaks common idioms, for example
the soft links.
* sem_util.adb: Add an Assert.
2016-06-22 Bob Duff <duff@adacore.com>
* a-cuprqu.ads, a-cuprqu.adb: Completely rewrite this package. Use
red-black trees, which gives O(lg N) worst-case performance on
Enqueue and Dequeue. The previous version had O(N) Enqueue in
the worst case.
2016-06-22 Arnaud Charlet <charlet@adacore.com>
* sem_warn.adb: minor style fix in comment.
* spark_xrefs.ads (Scope_Num): type refined to positive integers.
* lib-xref-spark_specific.adb (Detect_And_Add_SPARK_Scope):
moved into scope of Collect_SPARK_Xrefs.
(Add_SPARK_Scope): moved into scope of Collect_SPARK_Xrefs;
now uses Dspec and Scope_Id from Collect_SPARK_Xrefs.
(Collect_SPARK_Xrefs): refactored to avoid retraversing the list
of scopes.
* sem_ch3.adb (Build_Discriminal): Set Parent of the discriminal.
2016-06-22 Arnaud Charlet <charlet@adacore.com>
* lib-xref-spark_specific.adb (Generate_Dereference): Assignment to not
......
gcc/ada/a-cuprqu.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2011-2015, Free Software Foundation, Inc. --
-- Copyright (C) 2011-2016, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -32,8 +32,8 @@
------------------------------------------------------------------------------
with System;
with Ada.Containers.Ordered_Sets;
with Ada.Containers.Synchronized_Queue_Interfaces;
with Ada.Finalization;
generic
with package Queue_Interfaces is
......@@ -59,63 +59,44 @@ package Ada.Containers.Unbounded_Priority_Queues is
pragma Implementation_Defined;
type List_Type is tagged limited private;
procedure Enqueue
(List : in out List_Type;
New_Item : Queue_Interfaces.Element_Type);
procedure Dequeue
(List : in out List_Type;
Element : out Queue_Interfaces.Element_Type);
procedure Dequeue
(List : in out List_Type;
At_Least : Queue_Priority;
Element : in out Queue_Interfaces.Element_Type;
Success : out Boolean);
function Length (List : List_Type) return Count_Type;
-- We use an ordered set to hold the queue elements. This gives O(lg N)
-- performance in the worst case for Enqueue and Dequeue.
-- Sequence_Number is used to distinguish equivalent items. Each Enqueue
-- uses a higher Sequence_Number, so that a new item is placed after
-- already-enqueued equivalent items.
--
-- At any time, the first set element is the one to be dequeued next (if
-- the queue is not empty).
function Max_Length (List : List_Type) return Count_Type;
type Set_Elem is record
Sequence_Number : Count_Type;
Item : Queue_Interfaces.Element_Type;
end record;
private
function "=" (X, Y : Queue_Interfaces.Element_Type) return Boolean is
(not Before (Get_Priority (X), Get_Priority (Y))
and then not Before (Get_Priority (Y), Get_Priority (X)));
-- Elements are equal if neither is Before the other
-- List_Type is implemented as a circular doubly-linked list with a
-- dummy header node; Prev and Next are the links. The list is in
-- decreasing priority order, so the highest-priority item is always
-- first. (If there are multiple items with the highest priority, the
-- oldest one is first.) Header.Element is undefined and not used.
--
-- In addition, Next_Unequal points to the next item with a different
-- (i.e. strictly lower) priority. This is used to speed up the search
-- for the next lower-priority item, in cases where there are many items
-- with the same priority.
--
-- An empty list has Header.Prev, Header.Next, and Header.Next_Unequal
-- all pointing to Header. A nonempty list has Header.Next_Unequal
-- pointing to the first "real" item, and the last item has Next_Unequal
-- pointing back to Header.
type Node_Type;
type Node_Access is access all Node_Type;
type Node_Type is limited record
Element : Queue_Interfaces.Element_Type;
Prev, Next : Node_Access := Node_Type'Unchecked_Access;
Next_Unequal : Node_Access := Node_Type'Unchecked_Access;
end record;
function "=" (X, Y : Set_Elem) return Boolean is
(X.Sequence_Number = Y.Sequence_Number and then X.Item = Y.Item);
-- Set_Elems are equal if the elements are equal, and the
-- Sequence_Numbers are equal. This is passed to Ordered_Sets.
type List_Type is new Ada.Finalization.Limited_Controlled with record
Header : aliased Node_Type;
Length : Count_Type := 0;
Max_Length : Count_Type := 0;
end record;
function "<" (X, Y : Set_Elem) return Boolean is
(if X.Item = Y.Item
then X.Sequence_Number < Y.Sequence_Number
else Before (Get_Priority (X.Item), Get_Priority (Y.Item)));
-- If the items are equal, Sequence_Number breaks the tie. Otherwise,
-- use Before. This is passed to Ordered_Sets.
overriding procedure Finalize (List : in out List_Type);
pragma Suppress (Container_Checks);
package Sets is new Ada.Containers.Ordered_Sets (Set_Elem);
end Implementation;
use Implementation, Implementation.Sets;
protected type Queue (Ceiling : System.Any_Priority := Default_Ceiling)
with
Priority => Ceiling
......@@ -142,7 +123,15 @@ package Ada.Containers.Unbounded_Priority_Queues is
overriding function Peak_Use return Count_Type;
private
List : Implementation.List_Type;
Q_Elems : Set;
-- Elements of the queue
Max_Length : Count_Type := 0;
-- The current length of the queue is the Length of Q_Elems. This is the
-- maximum value of that, so far. Updated by Enqueue.
Next_Sequence_Number : Count_Type := 0;
-- Steadily increasing counter
end Queue;
end Ada.Containers.Unbounded_Priority_Queues;
gcc/ada/debug.adb
......@@ -105,7 +105,7 @@ package body Debug is
-- d.l Use Ada 95 semantics for limited function returns
-- d.m For -gnatl, print full source only for main unit
-- d.n Print source file names
-- d.o
-- d.o Conservative elaboration order for indirect calls
-- d.p
-- d.q
-- d.r Enable OK_To_Reorder_Components in non-variant records
......@@ -556,6 +556,9 @@ package body Debug is
-- compiler has a bug -- these are the files that need to be included
-- in a bug report.
-- d.o Conservative elaboration order for indirect calls. This causes
-- P'Access to be treated as a call in more cases.
-- d.r Forces the flag OK_To_Reorder_Components to be set in all record
-- base types that have no discriminants.
......
gcc/ada/exp_util.adb
......@@ -355,12 +355,15 @@ package body Exp_Util is
return;
-- Otherwise we perform a conversion from the current type, which
-- must be Standard.Boolean, to the desired type.
-- must be Standard.Boolean, to the desired type. Use the base
-- type to prevent spurious constraint checks that are extraneous
-- to the transformation. The type and its base have the same
-- representation, standard or otherwise.
else
Set_Analyzed (N);
Rewrite (N, Convert_To (T, N));
Analyze_And_Resolve (N, T);
Rewrite (N, Convert_To (Base_Type (T), N));
Analyze_And_Resolve (N, Base_Type (T));
end if;
end;
end if;
......
gcc/ada/sem_ch13.adb
......@@ -8552,8 +8552,7 @@ package body Sem_Ch13 is
Expression => Expr))));
-- If declaration has not been analyzed yet, Insert declaration
-- before freeze node.
-- Insert body after freeze node.
-- before freeze node. Insert body itself after freeze node.
if not Analyzed (FDecl) then
Insert_Before_And_Analyze (N, FDecl);
......@@ -11644,9 +11643,11 @@ package body Sem_Ch13 is
-- to specify a static predicate for a subtype which is inheriting a
-- dynamic predicate, so the static predicate validation here ignores
-- the inherited predicate even if it is dynamic.
-- In all cases, a static predicate can only apply to a scalar type.
elsif Nkind (Expr) = N_Function_Call
and then Is_Predicate_Function (Entity (Name (Expr)))
and then Is_Scalar_Type (Etype (First_Entity (Entity (Name (Expr)))))
then
return True;
......
gcc/ada/sem_ch3.adb
......@@ -9182,6 +9182,7 @@ package body Sem_Ch3 is
Set_Mechanism (D_Minal, Default_Mechanism);
Set_Etype (D_Minal, Etype (Discrim));
Set_Scope (D_Minal, Current_Scope);
Set_Parent (D_Minal, Parent (Discrim));
Set_Discriminal (Discrim, D_Minal);
Set_Discriminal_Link (D_Minal, Discrim);
......
gcc/ada/sem_elab.adb
......@@ -2139,7 +2139,8 @@ package body Sem_Elab is
-- node comes from source.
if Nkind (N) = N_Attribute_Reference
and then (not Warn_On_Elab_Access or else not Comes_From_Source (N))
and then ((not Warn_On_Elab_Access and then not Debug_Flag_Dot_O)
or else not Comes_From_Source (N))
then
return;
......
gcc/ada/sem_util.adb
......@@ -6314,6 +6314,7 @@ package body Sem_Util is
Encl_Unit := Library_Unit (Encl_Unit);
end loop;
pragma Assert (Nkind (Encl_Unit) = N_Compilation_Unit);
return Encl_Unit;
end Enclosing_Lib_Unit_Node;
......
gcc/ada/sem_warn.adb
......@@ -3367,7 +3367,7 @@ package body Sem_Warn is
P := Parent (C);
loop
-- If tree is not attached, do not issue warning (this is very
-- peculiar, and probably arises from some other error condition)
-- peculiar, and probably arises from some other error condition).
if No (P) then
return;
......
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