[multiple changes]

2014-10-10  Yannick Moy  <moy@adacore.com>

	* sem_prag.adb (Analyze_Global_Item): Accept formal objects in Global
	contracts.
	* errout.adb, errout.ads (SPARK_Msg_NE): Issue error unless
	SPARK_Mode is Off.

2014-10-10  Vadim Godunko  <godunko@adacore.com>

	* a-stwima.adb (To_Sequence): Compute size of result array.

2014-10-10  Javier Miranda  <miranda@adacore.com>

	* gnat_ugn.texi (Interfacing with C++ at the Class Level): Update the
	sources of the example to avoid a warning when the Ada files are
	automatically generated by the binding generator.

2014-10-10  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Resolve_Attribute, case 'Update): Set
	Do_Range_Check on the expression of a record component
	association when needed, as is done for array components, when
	the corresponding type is a scalar type.

From-SVN: r216084
This commit is contained in:
Arnaud Charlet 2014-10-10 16:00:07 +02:00
parent 79904ebc48
commit 33b87152da
7 changed files with 79 additions and 29 deletions

View File

@ -1,3 +1,27 @@
2014-10-10 Yannick Moy <moy@adacore.com>
* sem_prag.adb (Analyze_Global_Item): Accept formal objects in Global
contracts.
* errout.adb, errout.ads (SPARK_Msg_NE): Issue error unless
SPARK_Mode is Off.
2014-10-10 Vadim Godunko <godunko@adacore.com>
* a-stwima.adb (To_Sequence): Compute size of result array.
2014-10-10 Javier Miranda <miranda@adacore.com>
* gnat_ugn.texi (Interfacing with C++ at the Class Level): Update the
sources of the example to avoid a warning when the Ada files are
automatically generated by the binding generator.
2014-10-10 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb (Resolve_Attribute, case 'Update): Set
Do_Range_Check on the expression of a record component
association when needed, as is done for array components, when
the corresponding type is a scalar type.
2014-10-10 Gary Dismukes <dismukes@adacore.com> 2014-10-10 Gary Dismukes <dismukes@adacore.com>
* a-coinho-shared.adb: Minor typo fix. * a-coinho-shared.adb: Minor typo fix.

View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-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- --
@ -567,20 +567,25 @@ package body Ada.Strings.Wide_Maps is
function To_Sequence function To_Sequence
(Set : Wide_Character_Set) return Wide_Character_Sequence (Set : Wide_Character_Set) return Wide_Character_Sequence
is is
SS : constant Wide_Character_Ranges_Access := Set.Set; SS : constant Wide_Character_Ranges_Access := Set.Set;
N : Natural := 0;
Result : Wide_String (Positive range 1 .. 2 ** 16); Count : Natural := 0;
N : Natural := 0;
begin begin
for J in SS'Range loop for J in SS'Range loop
for K in SS (J).Low .. SS (J).High loop Count :=
N := N + 1; Count + (Wide_Character'Pos (SS (J).High) -
Result (N) := K; Wide_Character'Pos (SS (J).Low) + 1);
end loop;
end loop; end loop;
return Result (1 .. N); return Result : Wide_String (1 .. Count) do
for J in SS'Range loop
for K in SS (J).Low .. SS (J).High loop
N := N + 1;
Result (N) := K;
end loop;
end loop;
end return;
end To_Sequence; end To_Sequence;
------------ ------------

View File

@ -3153,7 +3153,7 @@ package body Errout is
E : Node_Or_Entity_Id) E : Node_Or_Entity_Id)
is is
begin begin
if SPARK_Mode = On then if SPARK_Mode /= Off then
Error_Msg_NE (Msg, N, E); Error_Msg_NE (Msg, N, E);
end if; end if;
end SPARK_Msg_NE; end SPARK_Msg_NE;

View File

@ -876,9 +876,8 @@ package Errout is
N : Node_Or_Entity_Id; N : Node_Or_Entity_Id;
E : Node_Or_Entity_Id); E : Node_Or_Entity_Id);
pragma Inline (SPARK_Msg_NE); pragma Inline (SPARK_Msg_NE);
-- Same as Error_Msg_NE, but the error is reported only when SPARK_Mode is -- Same as Error_Msg_NE, but the error is suppressed if SPARK_Mode is Off.
-- "on". The routine is inlined because it acts as a simple wrapper. -- The routine is inlined because it acts as a simple wrapper.
-- Is it right that this is so different from SPARK_Msg_N???
------------------------------------ ------------------------------------
-- Utility Interface for Back End -- -- Utility Interface for Back End --

View File

@ -2960,14 +2960,15 @@ constructors are defined on the C++ side and imported from the Ada
side, and latter the reverse case. side, and latter the reverse case.
The root of our derivation will be the @code{Animal} class, with a The root of our derivation will be the @code{Animal} class, with a
single private attribute (the @code{Age} of the animal) and two public single private attribute (the @code{Age} of the animal), a constructor,
primitives to set and get the value of this attribute. and two public primitives to set and get the value of this attribute.
@smallexample @smallexample
@b{class} Animal @{ @b{class} Animal @{
@b{public}: @b{public}:
@b{virtual} void Set_Age (int New_Age); @b{virtual} void Set_Age (int New_Age);
@b{virtual} int Age (); @b{virtual} int Age ();
Animal() @{Age_Count = 0;@};
@b{private}: @b{private}:
int Age_Count; int Age_Count;
@}; @};
@ -3013,19 +3014,19 @@ how to import these C++ declarations from the Ada side:
@smallexample @c ada @smallexample @c ada
@b{with} Interfaces.C.Strings; @b{use} Interfaces.C.Strings; @b{with} Interfaces.C.Strings; @b{use} Interfaces.C.Strings;
@b{package} Animals @b{is} @b{package} Animals @b{is}
@b{type} Carnivore @b{is} interface; @b{type} Carnivore @b{is} @b{limited} interface;
@b{pragma} Convention (C_Plus_Plus, Carnivore); @b{pragma} Convention (C_Plus_Plus, Carnivore);
@b{function} Number_Of_Teeth (X : Carnivore) @b{function} Number_Of_Teeth (X : Carnivore)
@b{return} Natural @b{is} @b{abstract}; @b{return} Natural @b{is} @b{abstract};
@b{type} Domestic @b{is} interface; @b{type} Domestic @b{is} @b{limited} interface;
@b{pragma} Convention (C_Plus_Plus, Set_Owner); @b{pragma} Convention (C_Plus_Plus, Domestic);
@b{procedure} Set_Owner @b{procedure} Set_Owner
(X : @b{in} @b{out} Domestic; (X : @b{in} @b{out} Domestic;
Name : Chars_Ptr) @b{is} @b{abstract}; Name : Chars_Ptr) @b{is} @b{abstract};
@b{type} Animal @b{is} @b{tagged} @b{record} @b{type} Animal @b{is} @b{tagged} @b{limited} @b{record}
Age : Natural := 0; Age : Natural;
@b{end} @b{record}; @b{end} @b{record};
@b{pragma} Import (C_Plus_Plus, Animal); @b{pragma} Import (C_Plus_Plus, Animal);
@ -3035,13 +3036,17 @@ how to import these C++ declarations from the Ada side:
@b{function} Age (X : Animal) @b{return} Integer; @b{function} Age (X : Animal) @b{return} Integer;
@b{pragma} Import (C_Plus_Plus, Age); @b{pragma} Import (C_Plus_Plus, Age);
@b{function} New_Animal @b{return} Animal;
@b{pragma} CPP_Constructor (New_Animal);
@b{pragma} Import (CPP, New_Animal, "_ZN6AnimalC1Ev");
@b{type} Dog @b{is} @b{new} Animal @b{and} Carnivore @b{and} Domestic @b{with} @b{record} @b{type} Dog @b{is} @b{new} Animal @b{and} Carnivore @b{and} Domestic @b{with} @b{record}
Tooth_Count : Natural; Tooth_Count : Natural;
Owner : String (1 .. 30); Owner : String (1 .. 30);
@b{end} @b{record}; @b{end} @b{record};
@b{pragma} Import (C_Plus_Plus, Dog); @b{pragma} Import (C_Plus_Plus, Dog);
@b{function} Number_Of_Teeth (A : Dog) @b{return} Integer; @b{function} Number_Of_Teeth (A : Dog) @b{return} Natural;
@b{pragma} Import (C_Plus_Plus, Number_Of_Teeth); @b{pragma} Import (C_Plus_Plus, Number_Of_Teeth);
@b{procedure} Set_Owner (A : @b{in} @b{out} Dog; Name : Chars_Ptr); @b{procedure} Set_Owner (A : @b{in} @b{out} Dog; Name : Chars_Ptr);
@ -3100,19 +3105,19 @@ them to C++, using the same hierarchy of our previous example:
@b{with} Interfaces.C.Strings; @b{with} Interfaces.C.Strings;
@b{use} Interfaces.C.Strings; @b{use} Interfaces.C.Strings;
@b{package} Animals @b{is} @b{package} Animals @b{is}
@b{type} Carnivore @b{is} interface; @b{type} Carnivore @b{is} @b{limited} interface;
@b{pragma} Convention (C_Plus_Plus, Carnivore); @b{pragma} Convention (C_Plus_Plus, Carnivore);
@b{function} Number_Of_Teeth (X : Carnivore) @b{function} Number_Of_Teeth (X : Carnivore)
@b{return} Natural @b{is} @b{abstract}; @b{return} Natural @b{is} @b{abstract};
@b{type} Domestic @b{is} interface; @b{type} Domestic @b{is} @b{limited} interface;
@b{pragma} Convention (C_Plus_Plus, Set_Owner); @b{pragma} Convention (C_Plus_Plus, Domestic);
@b{procedure} Set_Owner @b{procedure} Set_Owner
(X : @b{in} @b{out} Domestic; (X : @b{in} @b{out} Domestic;
Name : Chars_Ptr) @b{is} @b{abstract}; Name : Chars_Ptr) @b{is} @b{abstract};
@b{type} Animal @b{is} @b{tagged} @b{record} @b{type} Animal @b{is} @b{tagged} @b{record}
Age : Natural := 0; Age : Natural;
@b{end} @b{record}; @b{end} @b{record};
@b{pragma} Convention (C_Plus_Plus, Animal); @b{pragma} Convention (C_Plus_Plus, Animal);
@ -3122,13 +3127,16 @@ them to C++, using the same hierarchy of our previous example:
@b{function} Age (X : Animal) @b{return} Integer; @b{function} Age (X : Animal) @b{return} Integer;
@b{pragma} Export (C_Plus_Plus, Age); @b{pragma} Export (C_Plus_Plus, Age);
@b{function} New_Animal @b{return} Animal'Class;
@b{pragma} Export (C_Plus_Plus, New_Animal);
@b{type} Dog @b{is} @b{new} Animal @b{and} Carnivore @b{and} Domestic @b{with} @b{record} @b{type} Dog @b{is} @b{new} Animal @b{and} Carnivore @b{and} Domestic @b{with} @b{record}
Tooth_Count : Natural; Tooth_Count : Natural;
Owner : String (1 .. 30); Owner : String (1 .. 30);
@b{end} @b{record}; @b{end} @b{record};
@b{pragma} Convention (C_Plus_Plus, Dog); @b{pragma} Convention (C_Plus_Plus, Dog);
@b{function} Number_Of_Teeth (A : Dog) @b{return} Integer; @b{function} Number_Of_Teeth (A : Dog) @b{return} Natural;
@b{pragma} Export (C_Plus_Plus, Number_Of_Teeth); @b{pragma} Export (C_Plus_Plus, Number_Of_Teeth);
@b{procedure} Set_Owner (A : @b{in} @b{out} Dog; Name : Chars_Ptr); @b{procedure} Set_Owner (A : @b{in} @b{out} Dog; Name : Chars_Ptr);
@ -3139,7 +3147,8 @@ them to C++, using the same hierarchy of our previous example:
@b{end} Animals; @b{end} Animals;
@end smallexample @end smallexample
Compared with our previous example the only difference is the use of Compared with our previous example the only differences are the use of
@code{pragma Convention} (instead of @code{pragma Import}), and the use of
@code{pragma Export} to indicate to the GNAT compiler that the primitives will @code{pragma Export} to indicate to the GNAT compiler that the primitives will
be available to C++. Thanks to the ABI compatibility, on the C++ side there is be available to C++. Thanks to the ABI compatibility, on the C++ side there is
nothing else to be done; as explained above, the only requirement is that all nothing else to be done; as explained above, the only requirement is that all

View File

@ -11021,13 +11021,21 @@ package body Sem_Attr is
else else
Assoc := First (Component_Associations (Aggr)); Assoc := First (Component_Associations (Aggr));
while Present (Assoc) loop while Present (Assoc) loop
Comp := First (Choices (Assoc)); Comp := First (Choices (Assoc));
Expr := Expression (Assoc);
if Nkind (Comp) /= N_Others_Choice if Nkind (Comp) /= N_Others_Choice
and then not Error_Posted (Comp) and then not Error_Posted (Comp)
then then
Resolve (Expression (Assoc), Etype (Entity (Comp))); Resolve (Expr, Etype (Entity (Comp)));
if Is_Scalar_Type (Etype (Entity (Comp)))
and then not Is_OK_Static_Expression (Expr)
then
Set_Do_Range_Check (Expr);
end if;
end if; end if;
Next (Assoc); Next (Assoc);

View File

@ -1977,6 +1977,11 @@ package body Sem_Prag is
elsif Ekind (Item_Id) = E_Constant then elsif Ekind (Item_Id) = E_Constant then
SPARK_Msg_N ("global item cannot denote a constant", Item); SPARK_Msg_N ("global item cannot denote a constant", Item);
-- A formal object may act as a global item inside a generic
elsif Is_Formal_Object (Item_Id) then
null;
-- The only legal references are those to abstract states and -- The only legal references are those to abstract states and
-- variables (SPARK RM 6.1.4(4)). -- variables (SPARK RM 6.1.4(4)).