+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
-- --
-- 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 --
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;
-- --
-- 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 --
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;
-- --
-- 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 --
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;
-- --
-- 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 --
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;
-- --
-- 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 --
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;
-- --
-- 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 --
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
-- --
-- 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- --
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;
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;
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;
----------------
-- 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
-- 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
-- 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
-- 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
-- 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
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
-- 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 --
----------------------------
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;
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
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
projects / gcc.git / commitdiff