[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:
parent
79904ebc48
commit
33b87152da
|
@ -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.
|
||||||
|
|
|
@ -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;
|
||||||
|
|
||||||
------------
|
------------
|
||||||
|
|
|
@ -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;
|
||||||
|
|
|
@ -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 --
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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);
|
||||||
|
|
|
@ -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)).
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue