mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-25 05:30:25 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2015-03-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Abstract_State): Use routine
	Malformed_State_Error to issue general errors.
	(Analyze_Pragma): Diagnose a syntax error related to a state
	declaration with a simple option.
	(Malformed_State_Error): New routine.

2015-03-04  Robert Dewar  <dewar@adacore.com>

	* a-strsup.adb (Super_Slice): Deal with super flat case.
	* einfo.ads: Minor reformatting.
	* s-imgdec.adb (Set_Decimal_Digits): Add comment about possibly
	redundant code.

2015-03-04  Claire Dross  <dross@adacore.com>

	* a-cfdlli.ads, a-cfhase.ads, a-cforma.ads, a-cfhama.ads,
	a-cforse.ads, a-cofove.ads: Use Default_Initial_Condition on formal
	containers.

From-SVN: r221180
This commit is contained in:
Arnaud Charlet 2015-03-04 11:01:40 +01:00
parent 5264d0df90
commit 203876fcae
11 changed files with 128 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
gcc/ada/ChangeLog
View File

@ -1,3 +1,24 @@
2015-03-04 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Abstract_State): Use routine
Malformed_State_Error to issue general errors.
(Analyze_Pragma): Diagnose a syntax error related to a state
declaration with a simple option.
(Malformed_State_Error): New routine.
2015-03-04 Robert Dewar <dewar@adacore.com>
* a-strsup.adb (Super_Slice): Deal with super flat case.
* einfo.ads: Minor reformatting.
* s-imgdec.adb (Set_Decimal_Digits): Add comment about possibly
redundant code.
2015-03-04 Claire Dross <dross@adacore.com>
* a-cfdlli.ads, a-cfhase.ads, a-cforma.ads, a-cfhama.ads,
a-cforse.ads, a-cofove.ads: Use Default_Initial_Condition on formal
containers.
2015-03-04 Ed Schonberg <schonberg@adacore.com>
* sem_warn.adb (Check_References): When checking for an unused

4
gcc/ada/a-cfdlli.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2015, 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 --
@ -72,7 +72,7 @@ is
Next => Next,
Has_Element => Has_Element,
Element => Element),
Default_Initial_Condition;
Default_Initial_Condition => Is_Empty (List);
pragma Preelaborable_Initialization (List);
type Cursor is private;

4
gcc/ada/a-cfhama.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2015, 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 --
@ -76,7 +76,7 @@ is
Next => Next,
Has_Element => Has_Element,
Element => Element),
Default_Initial_Condition;
Default_Initial_Condition => Is_Empty (Map);
pragma Preelaborable_Initialization (Map);
type Cursor is private;

4
gcc/ada/a-cfhase.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2015, 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 --
@ -78,7 +78,7 @@ is
Next => Next,
Has_Element => Has_Element,
Element => Element),
Default_Initial_Condition;
Default_Initial_Condition => Is_Empty (Set);
pragma Preelaborable_Initialization (Set);
type Cursor is private;

4
gcc/ada/a-cforma.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2015, 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 --
@ -80,7 +80,7 @@ is
Next => Next,
Has_Element => Has_Element,
Element => Element),
Default_Initial_Condition;
Default_Initial_Condition => Is_Empty (Map);
pragma Preelaborable_Initialization (Map);
type Cursor is private;

4
gcc/ada/a-cforse.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2015, 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 --
@ -79,7 +79,7 @@ is
Next => Next,
Has_Element => Has_Element,
Element => Element),
Default_Initial_Condition;
Default_Initial_Condition => Is_Empty (Set);
pragma Preelaborable_Initialization (Set);
type Cursor is private;

4
gcc/ada/a-cofove.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2015, 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 --
@ -61,7 +61,7 @@ is
Count_Type range 0 .. Count_Type (Index_Type'Last - Index_Type'First + 1);
type Vector (Capacity : Capacity_Range) is limited private with
Default_Initial_Condition;
Default_Initial_Condition => Is_Empty (Vector);
-- In the bounded case, Capacity is the capacity of the container, which
-- never changes. In the unbounded case, Capacity is the initial capacity
-- of the container, and operations such as Reserve_Capacity and Append can

17
gcc/ada/a-strsup.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2003-2015, 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- --
@ -1473,6 +1473,9 @@ package body Ada.Strings.Superbounded is
raise Index_Error;
end if;
-- Note: in this case, superflat bounds are not a problem, we just
-- get the null string in accordance with normal Ada slice rules.
R := Source.Data (Low .. High);
end return;
end Super_Slice;
@ -1490,7 +1493,9 @@ package body Ada.Strings.Superbounded is
raise Index_Error;
end if;
Result.Current_Length := High - Low + 1;
-- Note: the Max operation here deals with the superflat case
Result.Current_Length := Integer'Max (0, High - Low + 1);
Result.Data (1 .. Result.Current_Length) := Source.Data (Low .. High);
end return;
end Super_Slice;
@ -1506,10 +1511,12 @@ package body Ada.Strings.Superbounded is
or else High > Source.Current_Length
then
raise Index_Error;
else
Target.Current_Length := High - Low + 1;
Target.Data (1 .. Target.Current_Length) := Source.Data (Low .. High);
end if;
-- Note: the Max operation here deals with the superflat case
Target.Current_Length := Integer'Max (0, High - Low + 1);
Target.Data (1 .. Target.Current_Length) := Source.Data (Low .. High);
end Super_Slice;
----------------

46
gcc/ada/einfo.ads
View File

@ -3234,12 +3234,12 @@ package Einfo is
-- derived from a type with a clause present.
-- Master_Id (Node17)
-- Defined in access types and subtypes. Empty unless Has_Task is
-- set for the designated type, in which case it points to the entity
-- for the Master_Id for the access type master. Also set for access-to-
-- limited-class-wide types whose root may be extended with task
-- components, and for access-to-limited-interfaces because they can be
-- used to reference tasks implementing such interface.
-- Defined in access types and subtypes. Empty unless Has_Task is set for
-- the designated type, in which case it points to the entity for the
-- Master_Id for the access type master. Also set for access-to-limited-
-- class-wide types whose root may be extended with task components, and
-- for access-to-limited-interfaces because they can be used to reference
-- tasks implementing such interface.
-- Materialize_Entity (Flag168)
-- Defined in all entities. Set only for renamed obects which should be
@ -3317,10 +3317,10 @@ package Einfo is
-- not all of the fields in a partially initialized record). The code
-- generator should instead use the flag Is_True_Constant.
--
-- For the purposes of this warning, the default assignment of
-- access variables to null is not considered the assignment of
-- of a value (so the warning can be given for code that relies
-- on this initial null value, when no other value is ever set).
-- For the purposes of this warning, the default assignment of access
-- variables to null is not considered the assignment of a value (so
-- the warning can be given for code that relies on this initial null
-- value when no other value is ever set).
--
-- In variables and out parameters, if this flag is set after full
-- processing of the corresponding declarative unit, it indicates that
@ -3333,10 +3333,10 @@ package Einfo is
-- statement sequence, the meaning of the flag is "not set yet", and
-- once this analysis is complete the flag means "never assigned".
-- Note: for variables appearing in package declarations, this flag
-- is never set. That is because there is no way to tell if some
-- client modifies the variable (or in the case of variables in the
-- private part, if some child unit modifies the variables).
-- Note: for variables appearing in package declarations, this flag is
-- never set. That is because there is no way to tell if some client
-- modifies the variable (or, in the case of variables in the private
-- part, if some child unit modifies the variables).
-- Note: in the case of renamed objects, the flag must be set in the
-- ultimate renamed object. Clients noting a possible modification
@ -3358,12 +3358,12 @@ package Einfo is
-- discriminants in the record.
-- Next_Discriminant (synthesized)
-- Applies to discriminants returned by First/Next_Discriminant.
-- Returns the next language-defined (ie: perhaps non-girder)
-- discriminant by following the chain of declared entities as long as
-- the kind of the entity corresponds to a discriminant. Note that the
-- discriminants might be the only components of the record.
-- Returns Empty if there are no more.
-- Applies to discriminants returned by First/Next_Discriminant. Returns
-- the next language-defined (ie: perhaps non-girder) discriminant by
-- following the chain of declared entities as long as the kind of the
-- entity corresponds to a discriminant. Note that the discriminants
-- might be the only components of the record. Returns Empty if there
-- are no more discriminants.
-- Next_Entity (Node2)
-- Defined in all entities. The entities of a scope are chained, with
@ -3374,9 +3374,9 @@ package Einfo is
-- field are in Sinfo.
-- Next_Formal (synthesized)
-- Applies to the entity for a formal parameter. Returns the next
-- formal parameter of the subprogram or subprogram type. Returns
-- Empty if there are no more formals.
-- Applies to the entity for a formal parameter. Returns the next formal
-- parameter of the subprogram or subprogram type. Returns Empty if there
-- are no more formals.
-- Next_Formal_With_Extras (synthesized)
-- Applies to the entity for a formal parameter. Returns the next

18
gcc/ada/s-imgdec.adb
View File

@ -330,6 +330,24 @@ package body System.Img_Dec is
DA := DA - LZ;
if DA < ND then
-- Note: it is definitely possible for the above condition
-- to be True, for example:
-- V => 1234, Scale => 5, Fore => 0, After => 1, Exp => 0
-- but in this case DA = 0, ND = 1, FD = 1, FD + DA-1 = 0
-- so the arguments in the call are (1, 0) meaning that no
-- digits are output.
-- No obvious example exists where the following call to
-- Set_Digits actually outputs some digits, but we lack a
-- proof that no such example exists.
-- So it is safer to retain this call, even though as a
-- result it is hard (or perhaps impossible) to create a
-- coverage test for the inlined code of the call.
Set_Digits (FD, FD + DA - 1);
else

49
gcc/ada/sem_prag.adb
View File

@ -9526,6 +9526,12 @@ package body Sem_Prag is
-- visibility chain. Pack_Id denotes the entity or the related
-- package where pragma Abstract_State appears.
procedure Malformed_State_Error (State : Node_Id);
-- Emit an error concerning the illegal declaration of abstract
-- state State. This routine diagnoses syntax errors that lead to
-- a different parse tree. The error is issued regardless of the
-- SPARK mode in effect.
----------------------------
-- Analyze_Abstract_State --
----------------------------
@ -10059,11 +10065,10 @@ package body Sem_Prag is
Next (Opt);
end loop;
-- Any other attempt to declare a state is illegal. This is a
-- syntax error, always report.
-- Any other attempt to declare a state is illegal
else
Error_Msg_N ("malformed abstract state declaration", State);
Malformed_State_Error (State);
return;
end if;
@ -10096,11 +10101,29 @@ package body Sem_Prag is
end if;
end Analyze_Abstract_State;
---------------------------
-- Malformed_State_Error --
---------------------------
procedure Malformed_State_Error (State : Node_Id) is
begin
Error_Msg_N ("malformed abstract state declaration", State);
-- An abstract state with a simple option is being declared
-- with "=>" rather than the legal "with". The state appears
-- as a component association.
if Nkind (State) = N_Component_Association then
Error_Msg_N ("\\use WITH to specify simple option", State);
end if;
end Malformed_State_Error;
-- Local variables
Pack_Decl : Node_Id;
Pack_Id : Entity_Id;
State : Node_Id;
States : Node_Id;
-- Start of processing for Abstract_State
@ -10137,22 +10160,34 @@ package body Sem_Prag is
Set_Is_Ghost_Entity (Pack_Id);
end if;
State := Expression (Get_Argument (N));
States := Expression (Get_Argument (N));
-- Multiple non-null abstract states appear as an aggregate
if Nkind (State) = N_Aggregate then
State := First (Expressions (State));
if Nkind (States) = N_Aggregate then
State := First (Expressions (States));
while Present (State) loop
Analyze_Abstract_State (State, Pack_Id);
Next (State);
end loop;
-- An abstract state with a simple option is being illegaly
-- declared with "=>" rather than "with". In this case the
-- state declaration appears as a component association.
if Present (Component_Associations (States)) then
State := First (Component_Associations (States));
while Present (State) loop
Malformed_State_Error (State);
Next (State);
end loop;
end if;
-- Various forms of a single abstract state. Note that these may
-- include malformed state declarations.
else
Analyze_Abstract_State (State, Pack_Id);
Analyze_Abstract_State (States, Pack_Id);
end if;
-- Save the pragma for retrieval by other tools