+2014-06-13 Yannick Moy <moy@adacore.com>
+
+ * exp_attr.adb Typo in comment.
+ * gnat1drv.adb (Adjust_Global_Switches): Force float overflow
+ checking in GNATprove_Mode.
+
+2014-06-13 Ed Schonberg <schonberg@adacore.com>
+
+ * a-coinho-shared.adb, a-coinho-shared.ads: Update shared version.
+
2014-06-13 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_ch9.adb, a-coinho.adb, a-coinho.ads: Minor
-- --
-- B o d y --
-- --
--- Copyright (C) 2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2013-2014, Free Software Foundation, Inc. --
-- --
-- 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- --
Container.Busy := 0;
end Adjust;
+ overriding procedure Adjust (Control : in out Reference_Control_Type) is
+ begin
+ if Control.Container /= null then
+ Reference (Control.Container);
+ end if;
+ end Adjust;
+
------------
-- Assign --
------------
Container.Reference := null;
end Clear;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Holder) return Constant_Reference_Type
+ is
+ Ref : constant Constant_Reference_Type :=
+ (Element => Container.Reference.Element,
+ Control => (Controlled with Container.Reference));
+ begin
+ Reference (Ref.Control.Container);
+ return Ref;
+ end Constant_Reference;
+
----------
-- Copy --
----------
function Copy (Source : Holder) return Holder is
begin
if Source.Reference = null then
- return (AF.Controlled with null, 0);
+ return (Controlled with null, 0);
else
Reference (Source.Reference);
- return (AF.Controlled with Source.Reference, 0);
+ return (Controlled with Source.Reference, 0);
end if;
end Copy;
end if;
end Finalize;
+ overriding procedure Finalize (Control : in out Reference_Control_Type) is
+ begin
+ if Control.Container /= null then
+ Unreference (Control.Container);
+ end if;
+
+ Control.Container := null;
+ end Finalize;
+
--------------
-- Is_Empty --
--------------
end if;
end Read;
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Read;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Read;
+
---------------
-- Reference --
---------------
System.Atomic_Counters.Increment (Item.Counter);
end Reference;
+ function Reference
+ (Container : aliased in out Holder) return Reference_Type
+ is
+ Ref : constant Reference_Type :=
+ (Element => Container.Reference.Element,
+ Control => (Controlled with Container.Reference));
+ begin
+ Reference (Ref.Control.Container);
+ return Ref;
+ end Reference;
+
---------------------
-- Replace_Element --
---------------------
begin
return
- (AF.Controlled with
+ (Controlled with
new Shared_Holder'
(Counter => <>,
Element => new Element_Type'(New_Item)), 0);
end if;
end Write;
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
end Ada.Containers.Indefinite_Holders;
-- --
-- S p e c --
-- --
--- Copyright (C) 2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2013-2014, 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 --
(Container : Holder;
Process : not null access procedure (Element : in out Element_Type));
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ type Reference_Type
+ (Element : not null access Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ function Constant_Reference
+ (Container : aliased Holder) return Constant_Reference_Type;
+ pragma Inline (Constant_Reference);
+
+ function Reference
+ (Container : aliased in out Holder) return Reference_Type;
+ pragma Inline (Reference);
+
procedure Assign (Target : in out Holder; Source : Holder);
function Copy (Source : Holder) return Holder;
private
- package AF renames Ada.Finalization;
+ use Ada.Finalization;
+ use Ada.Streams;
type Element_Access is access all Element_Type;
overriding procedure Adjust (Container : in out Holder);
overriding procedure Finalize (Container : in out Holder);
- Empty_Holder : constant Holder := (AF.Controlled with null, 0);
+ type Reference_Control_Type is new Controlled with
+ record
+ Container : Shared_Holder_Access;
+ end record;
+
+ overriding procedure Adjust (Control : in out Reference_Control_Type);
+ pragma Inline (Adjust);
+
+ overriding procedure Finalize (Control : in out Reference_Control_Type);
+ pragma Inline (Finalize);
+
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is
+ record
+ Control : Reference_Control_Type;
+ end record;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Constant_Reference_Type);
+
+ for Constant_Reference_Type'Write use Write;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Constant_Reference_Type);
+
+ for Constant_Reference_Type'Read use Read;
+
+ type Reference_Type (Element : not null access Element_Type) is record
+ Control : Reference_Control_Type;
+ end record;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type);
+
+ for Reference_Type'Write use Write;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Reference_Type);
+
+ for Reference_Type'Read use Read;
+
+ Empty_Holder : constant Holder := (Controlled with null, 0);
end Ada.Containers.Indefinite_Holders;
-- 1. Deal with enumeration types with holes
-- 2. For floating-point, generate call to attribute function and deal
- -- with range checking if Check_Float_Overflow modde.
+ -- with range checking if Check_Float_Overflow mode is set.
-- 3. For other cases, deal with constraint checking
when Attribute_Pred => Pred :
Dynamic_Elaboration_Checks := False;
+ -- Detect overflow on unconstrained floating-point types, such as
+ -- the predefined types Float, Long_Float and Long_Long_Float from
+ -- package Standard.
+
+ Check_Float_Overflow := True;
+
-- Set STRICT mode for overflow checks if not set explicitly. This
-- prevents suppressing of overflow checks by default, in code down
-- below.
projects / platform / upstream / linaro-gcc.git / commitdiff