OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
gcc/ada/ChangeLog
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>
* a-coinho-shared.adb: Minor typo fix.

25
gcc/ada/a-stwima.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- 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
(Set : Wide_Character_Set) return Wide_Character_Sequence
is
SS : constant Wide_Character_Ranges_Access := Set.Set;
Result : Wide_String (Positive range 1 .. 2 ** 16);
N : Natural := 0;
SS : constant Wide_Character_Ranges_Access := Set.Set;
N : Natural := 0;
Count : Natural := 0;
begin
for J in SS'Range loop
for K in SS (J).Low .. SS (J).High loop
N := N + 1;
Result (N) := K;
end loop;
Count :=
Count + (Wide_Character'Pos (SS (J).High) -
Wide_Character'Pos (SS (J).Low) + 1);
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;
------------

2
gcc/ada/errout.adb
View File

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

5
gcc/ada/errout.ads
View File

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

37
gcc/ada/gnat_ugn.texi
View File

@ -2960,14 +2960,15 @@ constructors are defined on the C++ side and imported from the Ada
side, and latter the reverse case.
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
primitives to set and get the value of this attribute.
single private attribute (the @code{Age} of the animal), a constructor,
and two public primitives to set and get the value of this attribute.
@smallexample
@b{class} Animal @{
@b{public}:
@b{virtual} void Set_Age (int New_Age);
@b{virtual} int Age ();
Animal() @{Age_Count = 0;@};
@b{private}:
int Age_Count;
@};
@ -3013,19 +3014,19 @@ how to import these C++ declarations from the Ada side:
@smallexample @c ada
@b{with} Interfaces.C.Strings; @b{use} Interfaces.C.Strings;
@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{function} Number_Of_Teeth (X : Carnivore)
@b{return} Natural @b{is} @b{abstract};
@b{type} Domestic @b{is} interface;
@b{pragma} Convention (C_Plus_Plus, Set_Owner);
@b{type} Domestic @b{is} @b{limited} interface;
@b{pragma} Convention (C_Plus_Plus, Domestic);
@b{procedure} Set_Owner
(X : @b{in} @b{out} Domestic;
Name : Chars_Ptr) @b{is} @b{abstract};
@b{type} Animal @b{is} @b{tagged} @b{record}
Age : Natural := 0;
@b{type} Animal @b{is} @b{tagged} @b{limited} @b{record}
Age : Natural;
@b{end} @b{record};
@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{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}
Tooth_Count : Natural;
Owner : String (1 .. 30);
@b{end} @b{record};
@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{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{use} Interfaces.C.Strings;
@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{function} Number_Of_Teeth (X : Carnivore)
@b{return} Natural @b{is} @b{abstract};
@b{type} Domestic @b{is} interface;
@b{pragma} Convention (C_Plus_Plus, Set_Owner);
@b{type} Domestic @b{is} @b{limited} interface;
@b{pragma} Convention (C_Plus_Plus, Domestic);
@b{procedure} Set_Owner
(X : @b{in} @b{out} Domestic;
Name : Chars_Ptr) @b{is} @b{abstract};
@b{type} Animal @b{is} @b{tagged} @b{record}
Age : Natural := 0;
Age : Natural;
@b{end} @b{record};
@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{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}
Tooth_Count : Natural;
Owner : String (1 .. 30);
@b{end} @b{record};
@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{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;
@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
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

10
gcc/ada/sem_attr.adb
View File

@ -11021,13 +11021,21 @@ package body Sem_Attr is
else
Assoc := First (Component_Associations (Aggr));
while Present (Assoc) loop
Comp := First (Choices (Assoc));
Expr := Expression (Assoc);
if Nkind (Comp) /= N_Others_Choice
and then not Error_Posted (Comp)
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;
Next (Assoc);

5
gcc/ada/sem_prag.adb
View File

@ -1977,6 +1977,11 @@ package body Sem_Prag is
elsif Ekind (Item_Id) = E_Constant then
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
-- variables (SPARK RM 6.1.4(4)).