Commit 783da331 by Arnaud Charlet

[multiple changes]

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.

From-SVN: r211629
parent 129bbe43
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> 2014-06-13 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_ch9.adb, a-coinho.adb, a-coinho.ads: Minor * sem_ch3.adb, sem_ch9.adb, a-coinho.adb, a-coinho.ads: Minor
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- --
...@@ -62,6 +62,13 @@ package body Ada.Containers.Indefinite_Holders is ...@@ -62,6 +62,13 @@ package body Ada.Containers.Indefinite_Holders is
Container.Busy := 0; Container.Busy := 0;
end Adjust; 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 -- -- Assign --
------------ ------------
...@@ -99,6 +106,21 @@ package body Ada.Containers.Indefinite_Holders is ...@@ -99,6 +106,21 @@ package body Ada.Containers.Indefinite_Holders is
Container.Reference := null; Container.Reference := null;
end Clear; 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 -- -- Copy --
---------- ----------
...@@ -106,11 +128,11 @@ package body Ada.Containers.Indefinite_Holders is ...@@ -106,11 +128,11 @@ package body Ada.Containers.Indefinite_Holders is
function Copy (Source : Holder) return Holder is function Copy (Source : Holder) return Holder is
begin begin
if Source.Reference = null then if Source.Reference = null then
return (AF.Controlled with null, 0); return (Controlled with null, 0);
else else
Reference (Source.Reference); Reference (Source.Reference);
return (AF.Controlled with Source.Reference, 0); return (Controlled with Source.Reference, 0);
end if; end if;
end Copy; end Copy;
...@@ -143,6 +165,15 @@ package body Ada.Containers.Indefinite_Holders is ...@@ -143,6 +165,15 @@ package body Ada.Containers.Indefinite_Holders is
end if; end if;
end Finalize; 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 -- -- Is_Empty --
-------------- --------------
...@@ -223,6 +254,22 @@ package body Ada.Containers.Indefinite_Holders is ...@@ -223,6 +254,22 @@ package body Ada.Containers.Indefinite_Holders is
end if; end if;
end Read; 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 -- -- Reference --
--------------- ---------------
...@@ -232,6 +279,17 @@ package body Ada.Containers.Indefinite_Holders is ...@@ -232,6 +279,17 @@ package body Ada.Containers.Indefinite_Holders is
System.Atomic_Counters.Increment (Item.Counter); System.Atomic_Counters.Increment (Item.Counter);
end Reference; 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 -- -- Replace_Element --
--------------------- ---------------------
...@@ -287,7 +345,7 @@ package body Ada.Containers.Indefinite_Holders is ...@@ -287,7 +345,7 @@ package body Ada.Containers.Indefinite_Holders is
begin begin
return return
(AF.Controlled with (Controlled with
new Shared_Holder' new Shared_Holder'
(Counter => <>, (Counter => <>,
Element => new Element_Type'(New_Item)), 0); Element => new Element_Type'(New_Item)), 0);
...@@ -355,4 +413,20 @@ package body Ada.Containers.Indefinite_Holders is ...@@ -355,4 +413,20 @@ package body Ada.Containers.Indefinite_Holders is
end if; end if;
end Write; 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; end Ada.Containers.Indefinite_Holders;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -67,6 +67,24 @@ package Ada.Containers.Indefinite_Holders is ...@@ -67,6 +67,24 @@ package Ada.Containers.Indefinite_Holders is
(Container : Holder; (Container : Holder;
Process : not null access procedure (Element : in out Element_Type)); 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); procedure Assign (Target : in out Holder; Source : Holder);
function Copy (Source : Holder) return Holder; function Copy (Source : Holder) return Holder;
...@@ -75,7 +93,8 @@ package Ada.Containers.Indefinite_Holders is ...@@ -75,7 +93,8 @@ package Ada.Containers.Indefinite_Holders is
private private
package AF renames Ada.Finalization; use Ada.Finalization;
use Ada.Streams;
type Element_Access is access all Element_Type; type Element_Access is access all Element_Type;
...@@ -110,6 +129,51 @@ private ...@@ -110,6 +129,51 @@ private
overriding procedure Adjust (Container : in out Holder); overriding procedure Adjust (Container : in out Holder);
overriding procedure Finalize (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; end Ada.Containers.Indefinite_Holders;
...@@ -4441,7 +4441,7 @@ package body Exp_Attr is ...@@ -4441,7 +4441,7 @@ package body Exp_Attr is
-- 1. Deal with enumeration types with holes -- 1. Deal with enumeration types with holes
-- 2. For floating-point, generate call to attribute function and deal -- 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 -- 3. For other cases, deal with constraint checking
when Attribute_Pred => Pred : when Attribute_Pred => Pred :
......
...@@ -364,6 +364,12 @@ procedure Gnat1drv is ...@@ -364,6 +364,12 @@ procedure Gnat1drv is
Dynamic_Elaboration_Checks := False; 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 -- Set STRICT mode for overflow checks if not set explicitly. This
-- prevents suppressing of overflow checks by default, in code down -- prevents suppressing of overflow checks by default, in code down
-- below. -- below.
......
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