Skip to content

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

[multiple changes] 

2013-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Apply_Predicate_Check): Update the comment associated
	with the call to Check_Expression_Against_Static_Predicate.
	* sem_ch3.adb (Analyze_Object_Declaration): Update the comment
	associated with the call to Check_Expression_Against_Static_Predicate.
	* sem_util.adb (Check_Expression_Against_Static_Predicate):
	Broaden the check from a static expression to an expression with
	a known value at compile time.
	* sem_util.ads (Check_Expression_Against_Static_Predicate): Update
	comment on usage.

2013-04-25  Thomas Quinot  <quinot@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference, cases Position,
	First_Bit, and Last_Bit): Fix incorrect test in implementation of
	RM 2005 13.5.2(3/2).

2013-04-25  Claire Dross  <dross@adacore.com>

	* a-cfhase.adb, a-cfhase.ads, a-cforma.adb, a-cforma.ads, a-cfhama.adb,
	a-cfhama.ads, a-cforse.adb, a-cforse.ads, a-cofove.adb, a-cofove.ads
	(Query_Element): Removed.
	(Update_Element): Removed.
	(Insert): The version with no New_Item specified is removed.
	(Iterate): Removed.
	(Write): Removed.
	(Read): Removed.
	Every check of fields Busy and Lock has been removed.

2013-04-25  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb (Analyze_Pragma, case Contract_Cases): Remove
	call to S14_Pragma (Find_Related_Subprogram): Require proper
	placement in subprogram body (Find_Related_Subprogram): Detect
	duplicates for all cases (Find_Related_Subprogram): Handle case
	of spec nested inside body.

From-SVN: r198297
parent f197d2f2
Showing with 152 additions and 1615 deletions
gcc/ada/ChangeLog
2013-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* checks.adb (Apply_Predicate_Check): Update the comment associated
with the call to Check_Expression_Against_Static_Predicate.
* sem_ch3.adb (Analyze_Object_Declaration): Update the comment
associated with the call to Check_Expression_Against_Static_Predicate.
* sem_util.adb (Check_Expression_Against_Static_Predicate):
Broaden the check from a static expression to an expression with
a known value at compile time.
* sem_util.ads (Check_Expression_Against_Static_Predicate): Update
comment on usage.
2013-04-25 Thomas Quinot <quinot@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference, cases Position,
First_Bit, and Last_Bit): Fix incorrect test in implementation of
RM 2005 13.5.2(3/2).
2013-04-25 Claire Dross <dross@adacore.com>
* a-cfhase.adb, a-cfhase.ads, a-cforma.adb, a-cforma.ads, a-cfhama.adb,
a-cfhama.ads, a-cforse.adb, a-cforse.ads, a-cofove.adb, a-cofove.ads
(Query_Element): Removed.
(Update_Element): Removed.
(Insert): The version with no New_Item specified is removed.
(Iterate): Removed.
(Write): Removed.
(Read): Removed.
Every check of fields Busy and Lock has been removed.
2013-04-25 Robert Dewar <dewar@adacore.com>
* sem_prag.adb (Analyze_Pragma, case Contract_Cases): Remove
call to S14_Pragma (Find_Related_Subprogram): Require proper
placement in subprogram body (Find_Related_Subprogram): Detect
duplicates for all cases (Find_Related_Subprogram): Handle case
of spec nested inside body.
2013-04-25 Arnaud Charlet <charlet@adacore.com>
* par-prag.adb: Fix typo.
......
gcc/ada/a-cfhama.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2013, 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 --
......@@ -52,7 +52,6 @@
-- See detailed specifications for these subprograms
private with Ada.Containers.Hash_Tables;
private with Ada.Streams;
generic
type Key_Type is private;
......@@ -87,14 +86,15 @@ package Ada.Containers.Formal_Hashed_Maps is
function Is_Empty (Container : Map) return Boolean;
-- ??? what does clear do to active elements?
procedure Clear (Container : in out Map);
procedure Assign (Target : in out Map; Source : Map);
-- ???
-- capacity=0 means use container.length as cap of tgt
-- modulos=0 means use default_modulous(container.length)
-- Copy returns a container stricty equal to Source
-- It must have the same cursors associated to each element
-- Therefore:
-- - capacity=0 means use container.capacity as cap of tgt
-- - the modulus cannot be changed.
function Copy
(Source : Map;
Capacity : Count_Type := 0) return Map;
......@@ -108,18 +108,6 @@ package Ada.Containers.Formal_Hashed_Maps is
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element
(Container : in out Map;
Position : Cursor;
Process : not null access
procedure (Key : Key_Type; Element : Element_Type));
procedure Update_Element
(Container : in out Map;
Position : Cursor;
Process : not null access
procedure (Key : Key_Type; Element : in out Element_Type));
procedure Move (Target : in out Map; Source : in out Map);
procedure Insert
......@@ -132,12 +120,6 @@ package Ada.Containers.Formal_Hashed_Maps is
procedure Insert
(Container : in out Map;
Key : Key_Type;
Position : out Cursor;
Inserted : out Boolean);
procedure Insert
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type);
procedure Include
......@@ -186,11 +168,6 @@ package Ada.Containers.Formal_Hashed_Maps is
Right : Map;
CRight : Cursor) return Boolean;
procedure Iterate
(Container : Map;
Process : not null access
procedure (Container : Map; Position : Cursor));
function Default_Modulus (Capacity : Count_Type) return Hash_Type;
function Strict_Equal (Left, Right : Map) return Boolean;
......@@ -237,39 +214,11 @@ private
new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
use HT_Types;
use Ada.Streams;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Container : Map);
for Map'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Container : out Map);
for Map'Read use Read;
type Map_Access is access all Map;
for Map_Access'Storage_Size use 0;
type Cursor is record
Node : Count_Type;
end record;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Cursor);
for Cursor'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
Empty_Map : constant Map := (Capacity => 0, Modulus => 0, others => <>);
No_Element : constant Cursor := (Node => 0);
......
gcc/ada/a-cfhase.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2013, 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 --
......@@ -52,7 +52,6 @@
-- See detailed specifications for these subprograms
private with Ada.Containers.Hash_Tables;
private with Ada.Streams;
generic
type Element_Type is private;
......@@ -68,8 +67,7 @@ package Ada.Containers.Formal_Hashed_Sets is
pragma Pure;
type Set (Capacity : Count_Type; Modulus : Hash_Type) is tagged private;
-- why is this commented out ???
-- pragma Preelaborable_Initialization (Set);
pragma Preelaborable_Initialization (Set);
type Cursor is private;
pragma Preelaborable_Initialization (Cursor);
......@@ -108,11 +106,6 @@ package Ada.Containers.Formal_Hashed_Sets is
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element
(Container : in out Set;
Position : Cursor;
Process : not null access procedure (Element : Element_Type));
procedure Move (Target : in out Set; Source : in out Set);
procedure Insert
......@@ -187,11 +180,6 @@ package Ada.Containers.Formal_Hashed_Sets is
(Left : Element_Type;
Right : Set; CRight : Cursor) return Boolean;
procedure Iterate
(Container : Set;
Process :
not null access procedure (Container : Set; Position : Cursor));
function Default_Modulus (Capacity : Count_Type) return Hash_Type;
generic
......@@ -222,12 +210,6 @@ package Ada.Containers.Formal_Hashed_Sets is
function Contains (Container : Set; Key : Key_Type) return Boolean;
procedure Update_Element_Preserving_Key
(Container : in out Set;
Position : Cursor;
Process : not null access
procedure (Element : in out Element_Type));
end Generic_Keys;
function Strict_Equal (Left, Right : Set) return Boolean;
......@@ -262,38 +244,13 @@ private
new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
use HT_Types;
use Ada.Streams;
type Cursor is record
Node : Count_Type;
end record;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Cursor);
for Cursor'Read use Read;
No_Element : constant Cursor := (Node => 0);
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Container : Set);
for Set'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Container : out Set);
for Set'Read use Read;
Empty_Set : constant Set := (Capacity => 0, Modulus => 0, others => <>);
end Ada.Containers.Formal_Hashed_Sets;
gcc/ada/a-cforma.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2013, 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 --
......@@ -54,7 +54,6 @@
-- See detailed specifications for these subprograms
private with Ada.Containers.Red_Black_Trees;
private with Ada.Streams;
generic
type Key_Type is private;
......@@ -99,18 +98,6 @@ package Ada.Containers.Formal_Ordered_Maps is
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element
(Container : in out Map;
Position : Cursor;
Process : not null access
procedure (Key : Key_Type; Element : Element_Type));
procedure Update_Element
(Container : in out Map;
Position : Cursor;
Process : not null access
procedure (Key : Key_Type; Element : in out Element_Type));
procedure Move (Target : in out Map; Source : in out Map);
procedure Insert
......@@ -123,12 +110,6 @@ package Ada.Containers.Formal_Ordered_Maps is
procedure Insert
(Container : in out Map;
Key : Key_Type;
Position : out Cursor;
Inserted : out Boolean);
procedure Insert
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type);
procedure Include
......@@ -183,16 +164,6 @@ package Ada.Containers.Formal_Ordered_Maps is
function Has_Element (Container : Map; Position : Cursor) return Boolean;
procedure Iterate
(Container : Map;
Process :
not null access procedure (Container : Map; Position : Cursor));
procedure Reverse_Iterate
(Container : Map;
Process : not null access
procedure (Container : Map; Position : Cursor));
function Strict_Equal (Left, Right : Map) return Boolean;
-- Strict_Equal returns True if the containers are physically equal, i.e.
-- they are structurally equal (function "=" returns True) and that they
......@@ -234,38 +205,12 @@ private
type Map (Capacity : Count_Type) is
new Tree_Types.Tree_Type (Capacity) with null record;
use Ada.Streams;
type Cursor is record
Node : Node_Access;
end record;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Cursor);
for Cursor'Read use Read;
Empty_Map : constant Map := (Capacity => 0, others => <>);
No_Element : constant Cursor := (Node => 0);
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Container : Map);
for Map'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Container : out Map);
for Map'Read use Read;
Empty_Map : constant Map := (Capacity => 0, others => <>);
end Ada.Containers.Formal_Ordered_Maps;
gcc/ada/a-cforse.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2013, 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 --
......@@ -53,7 +53,6 @@
-- See detailed specifications for these subprograms
private with Ada.Containers.Red_Black_Trees;
private with Ada.Streams;
generic
type Element_Type is private;
......@@ -100,11 +99,6 @@ package Ada.Containers.Formal_Ordered_Sets is
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element
(Container : in out Set;
Position : Cursor;
Process : not null access procedure (Element : Element_Type));
procedure Move (Target : in out Set; Source : in out Set);
procedure Insert
......@@ -195,16 +189,6 @@ package Ada.Containers.Formal_Ordered_Sets is
function Has_Element (Container : Set; Position : Cursor) return Boolean;
procedure Iterate
(Container : Set;
Process :
not null access procedure (Container : Set; Position : Cursor));
procedure Reverse_Iterate
(Container : Set;
Process : not null access
procedure (Container : Set; Position : Cursor));
generic
type Key_Type (<>) is private;
......@@ -237,12 +221,6 @@ package Ada.Containers.Formal_Ordered_Sets is
function Contains (Container : Set; Key : Key_Type) return Boolean;
procedure Update_Element_Preserving_Key
(Container : in out Set;
Position : Cursor;
Process : not null access
procedure (Element : in out Element_Type));
end Generic_Keys;
function Strict_Equal (Left, Right : Set) return Boolean;
......@@ -280,41 +258,13 @@ private
new Tree_Types.Tree_Type (Capacity) with null record;
use Red_Black_Trees;
use Ada.Streams;
type Set_Access is access all Set;
for Set_Access'Storage_Size use 0;
type Cursor is record
Node : Count_Type;
end record;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Cursor);
for Cursor'Read use Read;
No_Element : constant Cursor := (Node => 0);
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Container : Set);
for Set'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Container : out Set);
for Set'Read use Read;
Empty_Set : constant Set := (Capacity => 0, others => <>);
end Ada.Containers.Formal_Ordered_Sets;
gcc/ada/a-cofove.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2013, 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 --
......@@ -55,7 +55,6 @@
-- iterate over containers. Left returns the part of the container already
-- scanned and Right the part not scanned yet.
private with Ada.Streams;
with Ada.Containers;
use Ada.Containers;
......@@ -72,21 +71,9 @@ package Ada.Containers.Formal_Vectors is
range Index_Type'First - 1 ..
Index_Type'Min (Index_Type'Base'Last - 1, Index_Type'Last) + 1;
-- ??? i don't think we can do this...
-- TODO: we need the ARG to either figure out how to declare this subtype,
-- or eliminate the requirement that it be present.
-- subtype Capacity_Subtype is Count_Type -- correct name???
-- range 0 .. Count_Type'Max (0,
-- Index_Type'Pos (Index_Type'Last) -
-- Index_Type'Pos (Index_Type'First) + 1);
--
-- so for now:
subtype Capacity_Subtype is Count_Type;
No_Index : constant Extended_Index := Extended_Index'First;
type Vector (Capacity : Capacity_Subtype) is tagged private;
-- pragma Preelaborable_Initialization (Vector);
type Vector (Capacity : Count_Type) is tagged private;
type Cursor is private;
pragma Preelaborable_Initialization (Cursor);
......@@ -97,11 +84,9 @@ package Ada.Containers.Formal_Vectors is
function "=" (Left, Right : Vector) return Boolean;
function To_Vector (Length : Capacity_Subtype) return Vector;
function To_Vector
(New_Item : Element_Type;
Length : Capacity_Subtype) return Vector;
Length : Count_Type) return Vector;
function "&" (Left, Right : Vector) return Vector;
......@@ -111,17 +96,17 @@ package Ada.Containers.Formal_Vectors is
function "&" (Left, Right : Element_Type) return Vector;
function Capacity (Container : Vector) return Capacity_Subtype;
function Capacity (Container : Vector) return Count_Type;
procedure Reserve_Capacity
(Container : in out Vector;
Capacity : Capacity_Subtype);
Capacity : Count_Type);
function Length (Container : Vector) return Capacity_Subtype;
function Length (Container : Vector) return Count_Type;
procedure Set_Length
(Container : in out Vector;
Length : Capacity_Subtype);
Length : Count_Type);
function Is_Empty (Container : Vector) return Boolean;
......@@ -131,7 +116,7 @@ package Ada.Containers.Formal_Vectors is
function Copy
(Source : Vector;
Capacity : Capacity_Subtype := 0) return Vector;
Capacity : Count_Type := 0) return Vector;
function To_Cursor
(Container : Vector;
......@@ -157,26 +142,6 @@ package Ada.Containers.Formal_Vectors is
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element
(Container : Vector;
Index : Index_Type;
Process : not null access procedure (Element : Element_Type));
procedure Query_Element
(Container : Vector;
Position : Cursor;
Process : not null access procedure (Element : Element_Type));
procedure Update_Element
(Container : in out Vector;
Index : Index_Type;
Process : not null access procedure (Element : in out Element_Type));
procedure Update_Element
(Container : in out Vector;
Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
procedure Move (Target : in out Vector; Source : in out Vector);
procedure Insert
......@@ -214,17 +179,6 @@ package Ada.Containers.Formal_Vectors is
Position : out Cursor;
Count : Count_Type := 1);
procedure Insert
(Container : in out Vector;
Before : Extended_Index;
Count : Count_Type := 1);
procedure Insert
(Container : in out Vector;
Before : Cursor;
Position : out Cursor;
Count : Count_Type := 1);
procedure Prepend
(Container : in out Vector;
New_Item : Vector);
......@@ -243,17 +197,6 @@ package Ada.Containers.Formal_Vectors is
New_Item : Element_Type;
Count : Count_Type := 1);
procedure Insert_Space
(Container : in out Vector;
Before : Extended_Index;
Count : Count_Type := 1);
procedure Insert_Space
(Container : in out Vector;
Before : Cursor;
Position : out Cursor;
Count : Count_Type := 1);
procedure Delete
(Container : in out Vector;
Index : Extended_Index;
......@@ -324,16 +267,6 @@ package Ada.Containers.Formal_Vectors is
function Has_Element (Container : Vector; Position : Cursor) return Boolean;
procedure Iterate
(Container : Vector;
Process : not null access
procedure (Container : Vector; Position : Cursor));
procedure Reverse_Iterate
(Container : Vector;
Process : not null access
procedure (Container : Vector; Position : Cursor));
generic
with function "<" (Left, Right : Element_Type) return Boolean is <>;
package Generic_Sorting is
......@@ -357,8 +290,6 @@ private
pragma Inline (Element);
pragma Inline (First_Element);
pragma Inline (Last_Element);
pragma Inline (Query_Element);
pragma Inline (Update_Element);
pragma Inline (Replace_Element);
pragma Inline (Contains);
pragma Inline (Next);
......@@ -367,44 +298,16 @@ private
type Elements_Array is array (Count_Type range <>) of Element_Type;
function "=" (L, R : Elements_Array) return Boolean is abstract;
type Vector (Capacity : Capacity_Subtype) is tagged record
type Vector (Capacity : Count_Type) is tagged record
Elements : Elements_Array (1 .. Capacity);
Last : Extended_Index := No_Index;
Busy : Natural := 0;
Lock : Natural := 0;
end record;
use Ada.Streams;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Container : Vector);
for Vector'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Container : out Vector);
for Vector'Read use Read;
type Cursor is record
Valid : Boolean := True;
Index : Index_Type := Index_Type'First;
end record;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Position : Cursor);
for Cursor'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Position : out Cursor);
for Cursor'Read use Read;
Empty_Vector : constant Vector := (Capacity => 0, others => <>);
No_Element : constant Cursor := (Valid => False, Index => Index_Type'First);
......
gcc/ada/checks.adb
......@@ -2502,8 +2502,8 @@ package body Checks is
-- Here for normal case of predicate active
else
-- If the type has a static predicate and the expression is also
-- static, see if the expression satisfies the predicate.
-- If the type has a static predicate and the expression is known
-- at compile time, see if the expression satisfies the predicate.
Check_Expression_Against_Static_Predicate (N, Typ);
......
gcc/ada/exp_attr.adb
......@@ -2741,20 +2741,20 @@ package body Exp_Attr is
CE : constant Entity_Id := Entity (Selector_Name (Pref));
begin
-- In Ada 2005 (or later) if we have the standard nondefault
-- bit order, then we return the original value as given in
-- the component clause (RM 2005 13.5.2(3/2)).
-- In Ada 2005 (or later) if we have the non-default bit order, then
-- we return the original value as given in the component clause
-- (RM 2005 13.5.2(3/2)).
if Present (Component_Clause (CE))
and then Ada_Version >= Ada_2005
and then not Reverse_Bit_Order (Scope (CE))
and then Reverse_Bit_Order (Scope (CE))
then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Expr_Value (First_Bit (Component_Clause (CE)))));
Analyze_And_Resolve (N, Typ);
-- Otherwise (Ada 83/95 or Ada 2005 or later with reverse bit order),
-- Otherwise (Ada 83/95 or Ada 2005 or later with default bit order),
-- rewrite with normalized value if we know it statically.
elsif Known_Static_Component_Bit_Offset (CE) then
......@@ -3321,20 +3321,20 @@ package body Exp_Attr is
CE : constant Entity_Id := Entity (Selector_Name (Pref));
begin
-- In Ada 2005 (or later) if we have the standard nondefault
-- bit order, then we return the original value as given in
-- the component clause (RM 2005 13.5.2(4/2)).
-- In Ada 2005 (or later) if we have the non-default bit order, then
-- we return the original value as given in the component clause
-- (RM 2005 13.5.2(3/2)).
if Present (Component_Clause (CE))
and then Ada_Version >= Ada_2005
and then not Reverse_Bit_Order (Scope (CE))
and then Reverse_Bit_Order (Scope (CE))
then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Expr_Value (Last_Bit (Component_Clause (CE)))));
Analyze_And_Resolve (N, Typ);
-- Otherwise (Ada 83/95 or Ada 2005 or later with reverse bit order),
-- Otherwise (Ada 83/95 or Ada 2005 or later with default bit order),
-- rewrite with normalized value if we know it statically.
elsif Known_Static_Component_Bit_Offset (CE)
......@@ -4243,18 +4243,18 @@ package body Exp_Attr is
begin
if Present (Component_Clause (CE)) then
-- In Ada 2005 (or later) if we have the standard nondefault
-- bit order, then we return the original value as given in
-- the component clause (RM 2005 13.5.2(2/2)).
-- In Ada 2005 (or later) if we have the non-default bit order,
-- then we return the original value as given in the component
-- clause (RM 2005 13.5.2(2/2)).
if Ada_Version >= Ada_2005
and then not Reverse_Bit_Order (Scope (CE))
and then Reverse_Bit_Order (Scope (CE))
then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Expr_Value (Position (Component_Clause (CE)))));
-- Otherwise (Ada 83 or 95, or reverse bit order specified in
-- Otherwise (Ada 83 or 95, or default bit order specified in
-- later Ada version), return the normalized value.
else
......
gcc/ada/sem_ch3.adb
......@@ -3277,8 +3277,8 @@ package body Sem_Ch3 is
or else
Is_Partially_Initialized_Type (T, Include_Implicit => False))
then
-- If the type has a static predicate and the expression is also
-- static, see if the expression satisfies the predicate.
-- If the type has a static predicate and the expression is known at
-- compile time, see if the expression satisfies the predicate.
if Present (E) then
Check_Expression_Against_Static_Predicate (E, T);
......@@ -3297,8 +3297,7 @@ package body Sem_Ch3 is
if Is_String_Type (T) and then not Constant_Present (N) then
Check_SPARK_Restriction
("declaration of object of unconstrained type not allowed",
N);
("declaration of object of unconstrained type not allowed", N);
end if;
-- Nothing to do in deferred constant case
......
gcc/ada/sem_prag.adb
......@@ -202,7 +202,11 @@ package body Sem_Prag is
Check_Duplicates : Boolean := False) return Node_Id;
-- Find the declaration of the related subprogram subject to pragma Prag.
-- If flag Check_Duplicates is set, the routine emits errors concerning
-- duplicate pragmas.
-- duplicate pragmas. If a related subprogram is found, then either the
-- corresponding N_Subprogram_Declaration node is returned, or, if the
-- pragma applies to a subprogram body, then the N_Subprogram_Body node
-- is returned. Note that in the latter case, no check is made to ensure
-- that there is no separate declaration of the subprogram.
function Get_Base_Subprogram (Def_Id : Entity_Id) return Entity_Id;
-- If Def_Id refers to a renamed subprogram, then the base subprogram (the
......@@ -10043,7 +10047,6 @@ package body Sem_Prag is
begin
GNAT_Pragma;
S14_Pragma;
Check_Arg_Count (1);
-- Ensure the proper placement of the pragma. Contract_Cases must
......@@ -18113,63 +18116,83 @@ package body Sem_Prag is
is
Context : constant Node_Id := Parent (Prag);
Nam : constant Name_Id := Pragma_Name (Prag);
Decl : Node_Id;
Elmt : Node_Id;
Subp_Decl : Node_Id;
begin
-- The pragma is a byproduct of an aspect
pragma Assert (Nkind (Prag) = N_Pragma);
-- If the pragma comes from an aspect, then what we want is the
-- declaration to which the aspect is attached, i.e. its parent.
if Present (Corresponding_Aspect (Prag)) then
Subp_Decl := Parent (Corresponding_Aspect (Prag));
return Parent (Corresponding_Aspect (Prag));
end if;
-- The pragma is associated with a library-level subprogram
-- Otherwise the pragma must be a list element, and the first thing to
-- do is to position past any previous pragmas or generated code. What
-- we are doing here is looking for the preceding declaration. This is
-- also where we will check for a duplicate pragma.
elsif Nkind (Context) = N_Compilation_Unit_Aux then
Subp_Decl := Unit (Parent (Context));
pragma Assert (Is_List_Member (Prag));
-- The pragma appears inside the declarative part of a subprogram body
Elmt := Prag;
loop
Elmt := Prev (Elmt);
exit when No (Elmt);
elsif Nkind (Context) = N_Subprogram_Body then
Subp_Decl := Context;
-- Typically want we will want is the declaration original node. But
-- for the generic subprogram case, don't go to to the original node,
-- which is the unanalyzed tree: we need to attach the pre- and post-
-- conditions to the analyzed version at this point. They propagate
-- to the original tree when analyzing the corresponding body.
-- The pragma appears someplace after its related subprogram. Inspect
-- all previous declarations for a suitable candidate.
if Nkind (Elmt) not in N_Generic_Declaration then
Subp_Decl := Original_Node (Elmt);
else
Subp_Decl := Elmt;
end if;
else
Decl := Prag;
Subp_Decl := Empty;
while Present (Prev (Decl)) loop
Decl := Prev (Decl);
-- Skip prior pragmas
if Nkind (Decl) in N_Generic_Declaration then
Subp_Decl := Decl;
else
Subp_Decl := Original_Node (Decl);
if Nkind (Subp_Decl) = N_Pragma then
if Check_Duplicates and then Pragma_Name (Subp_Decl) = Nam then
Error_Msg_Name_1 := Nam;
Error_Msg_Sloc := Sloc (Subp_Decl);
Error_Msg_N ("pragma % duplicates pragma declared #", Prag);
end if;
-- Skip prior pragmas
-- Skip internally generated code
if Nkind (Subp_Decl) = N_Pragma then
if Check_Duplicates and then Pragma_Name (Subp_Decl) = Nam then
Error_Msg_Name_1 := Nam;
Error_Msg_Sloc := Sloc (Subp_Decl);
Error_Msg_N ("pragma % duplicates pragma declared #", Prag);
end if;
elsif not Comes_From_Source (Subp_Decl) then
null;
-- Skip internally generated code
-- Otherwise we have a declaration to return
elsif not Comes_From_Source (Subp_Decl) then
null;
else
return Subp_Decl;
end if;
end loop;
-- The nearest preceding declaration is the related subprogram
-- We fell through, which means there was no declaration preceding the
-- pragma (either it was the first element of the list, or we only had
-- other pragmas and generated code before it).
else
exit;
end if;
end loop;
end if;
-- The pragma is associated with a library-level subprogram
if Nkind (Context) = N_Compilation_Unit_Aux then
return Unit (Parent (Context));
return Subp_Decl;
-- The pragma appears inside the declarative part of a subprogram body
elsif Nkind (Context) = N_Subprogram_Body then
return Context;
-- Otherwise no subprogram found, return original pragma
else
return Prag;
end if;
end Find_Related_Subprogram;
-------------------------
......
gcc/ada/sem_util.adb
......@@ -1301,11 +1301,11 @@ package body Sem_Util is
Typ : Entity_Id)
is
begin
-- When both the predicate and the expression are static, evaluate the
-- check at compile time. A type becomes non-static when it has aspect
-- Dynamic_Predicate.
-- When the predicate is static and the value of the expression is known
-- at compile time, evaluate the predicate check. A type is non-static
-- when it has aspect Dynamic_Predicate.
if Is_OK_Static_Expression (Expr)
if Compile_Time_Known_Value (Expr)
and then Has_Predicates (Typ)
and then Present (Static_Predicate (Typ))
and then not Has_Dynamic_Predicate_Aspect (Typ)
......
gcc/ada/sem_util.ads
......@@ -195,9 +195,9 @@ package Sem_Util is
(Expr : Node_Id;
Typ : Entity_Id);
-- Determine whether an arbitrary expression satisfies the static predicate
-- of a type. The routine does nothing if Expr is non-static or Typ lacks a
-- static predicate, otherwise it may emit a warning if the expression is
-- prohibited by the predicate.
-- of a type. The routine does nothing if Expr is not known at compile time
-- or Typ lacks a static predicate, otherwise it may emit a warning if the
-- expression is prohibited by the predicate.
procedure Check_Fully_Declared (T : Entity_Id; N : Node_Id);
-- Verify that the full declaration of type T has been seen. If not, place
......
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