Skip to content

R
riscv-gcc-1
Commit 783da331 by Arnaud Charlet
Options

[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
Showing with 162 additions and 8 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/a-coinho-shared.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -62,6 +62,13 @@ package body Ada.Containers.Indefinite_Holders is
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 --
------------
......@@ -99,6 +106,21 @@ package body Ada.Containers.Indefinite_Holders is
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 --
----------
......@@ -106,11 +128,11 @@ package body Ada.Containers.Indefinite_Holders is
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;
......@@ -143,6 +165,15 @@ package body Ada.Containers.Indefinite_Holders is
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 --
--------------
......@@ -223,6 +254,22 @@ package body Ada.Containers.Indefinite_Holders is
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 --
---------------
......@@ -232,6 +279,17 @@ package body Ada.Containers.Indefinite_Holders is
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 --
---------------------
......@@ -287,7 +345,7 @@ package body Ada.Containers.Indefinite_Holders is
begin
return
(AF.Controlled with
(Controlled with
new Shared_Holder'
(Counter => <>,
Element => new Element_Type'(New_Item)), 0);
......@@ -355,4 +413,20 @@ package body Ada.Containers.Indefinite_Holders is
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;
gcc/ada/a-coinho-shared.ads
......@@ -6,7 +6,7 @@
-- --
-- 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 --
......@@ -67,6 +67,24 @@ package Ada.Containers.Indefinite_Holders is
(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;
......@@ -75,7 +93,8 @@ package Ada.Containers.Indefinite_Holders is
private
package AF renames Ada.Finalization;
use Ada.Finalization;
use Ada.Streams;
type Element_Access is access all Element_Type;
......@@ -110,6 +129,51 @@ private
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;
gcc/ada/exp_attr.adb
......@@ -4441,7 +4441,7 @@ package body Exp_Attr is
-- 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 :
......
gcc/ada/gnat1drv.adb
......@@ -364,6 +364,12 @@ procedure Gnat1drv is
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.
......
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