[multiple changes]

2014-11-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Analyze_Pragma, case Implemented): In ASIS
	(compile-only) mode, use original type declaration to determine
	whether protected type implements an interface.

2014-11-20  Yannick Moy  <moy@adacore.com>

	* a-cfdlli.adb, a-cfdlli.ads, a-cfinve.adb, a-cfinve.ads,
	* a-cofove.adb, a-cofove.ads: Mark spec as SPARK_Mode, and private
	part/body as SPARK_Mode Off.
	* a-cfhama.adb, a-cfhama.ads, a-cfhase.adb, a-cfhase.ads,
	* a-cforma.adb, a-cforma.ads, a-cforse.adb, a-cforse.ads: Use
	aspect instead of pragma for uniformity.

2014-11-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_util.adb (Is_EVF_Expression): Include
	attributes 'Loop_Entry, 'Old and 'Update to the logic.

2014-11-20  Bob Duff  <duff@adacore.com>

	* sem_res.adb (Make_Call_Into_Operator): Don't
	call Left_Opnd in the case of unary operators, because they only
	have Right.

From-SVN: r217838
This commit is contained in:
Arnaud Charlet 2014-11-20 12:16:44 +01:00
parent 6c802906a3
commit 5fde9688e0
18 changed files with 104 additions and 34 deletions

View File

@ -1,3 +1,29 @@
2014-11-20 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Analyze_Pragma, case Implemented): In ASIS
(compile-only) mode, use original type declaration to determine
whether protected type implements an interface.
2014-11-20 Yannick Moy <moy@adacore.com>
* a-cfdlli.adb, a-cfdlli.ads, a-cfinve.adb, a-cfinve.ads,
* a-cofove.adb, a-cofove.ads: Mark spec as SPARK_Mode, and private
part/body as SPARK_Mode Off.
* a-cfhama.adb, a-cfhama.ads, a-cfhase.adb, a-cfhase.ads,
* a-cforma.adb, a-cforma.ads, a-cforse.adb, a-cforse.ads: Use
aspect instead of pragma for uniformity.
2014-11-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_util.adb (Is_EVF_Expression): Include
attributes 'Loop_Entry, 'Old and 'Update to the logic.
2014-11-20 Bob Duff <duff@adacore.com>
* sem_res.adb (Make_Call_Into_Operator): Don't
call Left_Opnd in the case of unary operators, because they only
have Right.
2014-11-20 Pascal Obry <obry@adacore.com> 2014-11-20 Pascal Obry <obry@adacore.com>
* initialize.c (ProcListCS): New extern variable (critical section). * initialize.c (ProcListCS): New extern variable (critical section).

View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2010-2013, Free Software Foundation, Inc. -- -- Copyright (C) 2010-2014, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -27,7 +27,9 @@
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Formal_Doubly_Linked_Lists is package body Ada.Containers.Formal_Doubly_Linked_Lists with
SPARK_Mode => Off
is
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --

View File

@ -61,9 +61,11 @@ generic
with function "=" (Left, Right : Element_Type) with function "=" (Left, Right : Element_Type)
return Boolean is <>; return Boolean is <>;
package Ada.Containers.Formal_Doubly_Linked_Lists is package Ada.Containers.Formal_Doubly_Linked_Lists with
Pure,
SPARK_Mode
is
pragma Annotate (GNATprove, External_Axiomatization); pragma Annotate (GNATprove, External_Axiomatization);
pragma Pure;
type List (Capacity : Count_Type) is private with type List (Capacity : Count_Type) is private with
Iterable => (First => First, Iterable => (First => First,
@ -337,6 +339,7 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is
-- scanned yet. -- scanned yet.
private private
pragma SPARK_Mode (Off);
type Node_Type is record type Node_Type is record
Prev : Count_Type'Base := -1; Prev : Count_Type'Base := -1;

View File

@ -35,8 +35,9 @@ with Ada.Containers.Prime_Numbers; use Ada.Containers.Prime_Numbers;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Formal_Hashed_Maps is package body Ada.Containers.Formal_Hashed_Maps with
pragma SPARK_Mode (Off); SPARK_Mode => Off
is
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --

View File

@ -65,10 +65,11 @@ generic
with function Equivalent_Keys (Left, Right : Key_Type) return Boolean; with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
with function "=" (Left, Right : Element_Type) return Boolean is <>; with function "=" (Left, Right : Element_Type) return Boolean is <>;
package Ada.Containers.Formal_Hashed_Maps is package Ada.Containers.Formal_Hashed_Maps with
Pure,
SPARK_Mode
is
pragma Annotate (GNATprove, External_Axiomatization); pragma Annotate (GNATprove, External_Axiomatization);
pragma Pure;
pragma SPARK_Mode (On);
type Map (Capacity : Count_Type; Modulus : Hash_Type) is private with type Map (Capacity : Count_Type; Modulus : Hash_Type) is private with
Iterable => (First => First, Iterable => (First => First,
@ -272,6 +273,8 @@ package Ada.Containers.Formal_Hashed_Maps is
-- Overlap returns True if the containers have common keys -- Overlap returns True if the containers have common keys
private private
pragma SPARK_Mode (Off);
pragma Inline (Length); pragma Inline (Length);
pragma Inline (Is_Empty); pragma Inline (Is_Empty);
pragma Inline (Clear); pragma Inline (Clear);
@ -282,7 +285,6 @@ private
pragma Inline (Has_Element); pragma Inline (Has_Element);
pragma Inline (Equivalent_Keys); pragma Inline (Equivalent_Keys);
pragma Inline (Next); pragma Inline (Next);
pragma SPARK_Mode (Off);
type Node_Type is record type Node_Type is record
Key : Key_Type; Key : Key_Type;

View File

@ -35,8 +35,9 @@ with Ada.Containers.Prime_Numbers; use Ada.Containers.Prime_Numbers;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Formal_Hashed_Sets is package body Ada.Containers.Formal_Hashed_Sets with
pragma SPARK_Mode (Off); SPARK_Mode => Off
is
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --

View File

@ -67,10 +67,11 @@ generic
with function "=" (Left, Right : Element_Type) return Boolean is <>; with function "=" (Left, Right : Element_Type) return Boolean is <>;
package Ada.Containers.Formal_Hashed_Sets is package Ada.Containers.Formal_Hashed_Sets with
Pure,
SPARK_Mode
is
pragma Annotate (GNATprove, External_Axiomatization); pragma Annotate (GNATprove, External_Axiomatization);
pragma Pure;
pragma SPARK_Mode (On);
type Set (Capacity : Count_Type; Modulus : Hash_Type) is private with type Set (Capacity : Count_Type; Modulus : Hash_Type) is private with
Iterable => (First => First, Iterable => (First => First,
@ -335,9 +336,10 @@ package Ada.Containers.Formal_Hashed_Sets is
-- scanned yet. -- scanned yet.
private private
pragma Inline (Next);
pragma SPARK_Mode (Off); pragma SPARK_Mode (Off);
pragma Inline (Next);
type Node_Type is type Node_Type is
record record
Element : Element_Type; Element : Element_Type;

View File

@ -26,7 +26,9 @@
-- <http://www.gnu.org/licenses/>. -- -- <http://www.gnu.org/licenses/>. --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
package body Ada.Containers.Formal_Indefinite_Vectors is package body Ada.Containers.Formal_Indefinite_Vectors with
SPARK_Mode => Off
is
function H (New_Item : Element_Type) return Holder renames To_Holder; function H (New_Item : Element_Type) return Holder renames To_Holder;
function E (Container : Holder) return Element_Type renames Get; function E (Container : Holder) return Element_Type renames Get;

View File

@ -52,7 +52,9 @@ generic
-- size, and heap allocation will be avoided. If False, the containers can -- size, and heap allocation will be avoided. If False, the containers can
-- grow via heap allocation. -- grow via heap allocation.
package Ada.Containers.Formal_Indefinite_Vectors is package Ada.Containers.Formal_Indefinite_Vectors with
SPARK_Mode => On
is
pragma Annotate (GNATprove, External_Axiomatization); pragma Annotate (GNATprove, External_Axiomatization);
subtype Extended_Index is Index_Type'Base subtype Extended_Index is Index_Type'Base
@ -220,6 +222,7 @@ package Ada.Containers.Formal_Indefinite_Vectors is
Global => null; Global => null;
private private
pragma SPARK_Mode (Off);
pragma Inline (First_Index); pragma Inline (First_Index);
pragma Inline (Last_Index); pragma Inline (Last_Index);

View File

@ -34,8 +34,9 @@ pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys);
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Formal_Ordered_Maps is package body Ada.Containers.Formal_Ordered_Maps with
pragma SPARK_Mode (Off); SPARK_Mode => Off
is
----------------------------- -----------------------------
-- Node Access Subprograms -- -- Node Access Subprograms --

View File

@ -66,10 +66,11 @@ generic
with function "<" (Left, Right : Key_Type) return Boolean is <>; with function "<" (Left, Right : Key_Type) return Boolean is <>;
with function "=" (Left, Right : Element_Type) return Boolean is <>; with function "=" (Left, Right : Element_Type) return Boolean is <>;
package Ada.Containers.Formal_Ordered_Maps is package Ada.Containers.Formal_Ordered_Maps with
Pure,
SPARK_Mode
is
pragma Annotate (GNATprove, External_Axiomatization); pragma Annotate (GNATprove, External_Axiomatization);
pragma Pure;
pragma SPARK_Mode (On);
function Equivalent_Keys (Left, Right : Key_Type) return Boolean with function Equivalent_Keys (Left, Right : Key_Type) return Boolean with
Global => null; Global => null;
@ -273,9 +274,10 @@ package Ada.Containers.Formal_Ordered_Maps is
-- Overlap returns True if the containers have common keys -- Overlap returns True if the containers have common keys
private private
pragma SPARK_Mode (Off);
pragma Inline (Next); pragma Inline (Next);
pragma Inline (Previous); pragma Inline (Previous);
pragma SPARK_Mode (Off);
subtype Node_Access is Count_Type; subtype Node_Access is Count_Type;

View File

@ -38,8 +38,9 @@ pragma Elaborate_All
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Formal_Ordered_Sets is package body Ada.Containers.Formal_Ordered_Sets with
pragma SPARK_Mode (Off); SPARK_Mode => Off
is
------------------------------ ------------------------------
-- Access to Fields of Node -- -- Access to Fields of Node --

View File

@ -64,10 +64,11 @@ generic
with function "<" (Left, Right : Element_Type) return Boolean is <>; with function "<" (Left, Right : Element_Type) return Boolean is <>;
with function "=" (Left, Right : Element_Type) return Boolean is <>; with function "=" (Left, Right : Element_Type) return Boolean is <>;
package Ada.Containers.Formal_Ordered_Sets is package Ada.Containers.Formal_Ordered_Sets with
Pure,
SPARK_Mode
is
pragma Annotate (GNATprove, External_Axiomatization); pragma Annotate (GNATprove, External_Axiomatization);
pragma Pure;
pragma SPARK_Mode (On);
function Equivalent_Elements (Left, Right : Element_Type) return Boolean function Equivalent_Elements (Left, Right : Element_Type) return Boolean
with with
@ -353,9 +354,10 @@ package Ada.Containers.Formal_Ordered_Sets is
-- scanned yet. -- scanned yet.
private private
pragma SPARK_Mode (Off);
pragma Inline (Next); pragma Inline (Next);
pragma Inline (Previous); pragma Inline (Previous);
pragma SPARK_Mode (Off);
type Node_Type is record type Node_Type is record
Has_Element : Boolean := False; Has_Element : Boolean := False;

View File

@ -30,7 +30,9 @@ with Ada.Unchecked_Deallocation;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Formal_Vectors is package body Ada.Containers.Formal_Vectors with
SPARK_Mode => Off
is
Growth_Factor : constant := 2; Growth_Factor : constant := 2;
-- When growing a container, multiply current capacity by this. Doubling -- When growing a container, multiply current capacity by this. Doubling

View File

@ -46,7 +46,9 @@ generic
-- size, and heap allocation will be avoided. If False, the containers can -- size, and heap allocation will be avoided. If False, the containers can
-- grow via heap allocation. -- grow via heap allocation.
package Ada.Containers.Formal_Vectors is package Ada.Containers.Formal_Vectors with
SPARK_Mode
is
pragma Annotate (GNATprove, External_Axiomatization); pragma Annotate (GNATprove, External_Axiomatization);
subtype Extended_Index is Index_Type'Base subtype Extended_Index is Index_Type'Base
@ -230,6 +232,7 @@ package Ada.Containers.Formal_Vectors is
-- scanned yet. -- scanned yet.
private private
pragma SPARK_Mode (Off);
pragma Inline (First_Index); pragma Inline (First_Index);
pragma Inline (Last_Index); pragma Inline (Last_Index);

View File

@ -14657,6 +14657,12 @@ package body Sem_Prag is
(Is_Concurrent_Record_Type (Typ) (Is_Concurrent_Record_Type (Typ)
and then Present (Interfaces (Typ))) and then Present (Interfaces (Typ)))
-- In analysis-only mode, examine original protected type
or else
(Nkind (Parent (Typ)) = N_Protected_Type_Declaration
and then Present (Interface_List (Parent (Typ))))
-- Check for a private record extension with keyword -- Check for a private record extension with keyword
-- "synchronized". -- "synchronized".

View File

@ -1794,7 +1794,7 @@ package body Sem_Res is
and then Nkind (Original_Node (N)) = N_Function_Call and then Nkind (Original_Node (N)) = N_Function_Call
then then
declare declare
L : constant Node_Id := Left_Opnd (N); L : Node_Id;
R : constant Node_Id := Right_Opnd (N); R : constant Node_Id := Right_Opnd (N);
Old_First : constant Node_Id := Old_First : constant Node_Id :=
@ -1803,7 +1803,8 @@ package body Sem_Res is
begin begin
if Is_Binary then if Is_Binary then
Old_Sec := Next (Old_First); L := Left_Opnd (N);
Old_Sec := Next (Old_First);
-- If the original call has named associations, replace the -- If the original call has named associations, replace the
-- explicit actual parameter in the association with the proper -- explicit actual parameter in the association with the proper

View File

@ -10846,6 +10846,16 @@ package body Sem_Util is
N_Type_Conversion) N_Type_Conversion)
then then
return Is_EVF_Expression (Expression (N)); return Is_EVF_Expression (Expression (N));
-- Attributes 'Loop_Entry, 'Old and 'Update are an EVF expression when
-- their prefix denotes an EVF expression.
elsif Nkind (N) = N_Attribute_Reference
and then Nam_In (Attribute_Name (N), Name_Loop_Entry,
Name_Old,
Name_Update)
then
return Is_EVF_Expression (Prefix (N));
end if; end if;
return False; return False;