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

[multiple changes]

Browse Source 
2011-11-21  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch6.adb (Expand_Actuals): In Ada 2012, a function call
	with out parameters may generate assignments to force constraint
	checks. These checks must be properly placed in the code after the
	declaration or statement that contains the call.

2011-11-21  Fedor Rybin  <frybin@adacore.com>

	* gnat_ugn.texi: Adding info on current gnattest limitations an
	support of -X option.

2011-11-21  Robert Dewar  <dewar@adacore.com>

	* a-cfdlli.adb, a-cbdlli.adb: Minor reformatting.

From-SVN: r181559
This commit is contained in:
Arnaud Charlet 2011-11-21 12:22:47 +01:00
parent f3670c001c
commit bdf69d333e
5 changed files with 89 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
2011-11-21 Ed Schonberg <schonberg@adacore.com>
* exp_ch6.adb (Expand_Actuals): In Ada 2012, a function call
with out parameters may generate assignments to force constraint
checks. These checks must be properly placed in the code after the
declaration or statement that contains the call.
2011-11-21 Fedor Rybin <frybin@adacore.com>
* gnat_ugn.texi: Adding info on current gnattest limitations an
support of -X option.
2011-11-21 Robert Dewar <dewar@adacore.com>
* a-cfdlli.adb, a-cbdlli.adb: Minor reformatting.
2011-11-20 Robert Dewar <dewar@adacore.com>
* exp_ch6.adb, exp_util.adb: Minor reformatting

18
gcc/ada/a-cbdlli.adb
View File

@ -1164,10 +1164,11 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
"attempt to tamper with cursors of Source (list is busy)";
end if;
Clear (Target); -- checks busy bit of Target
-- Clear target, note that this checks busy bits of Target
Clear (Target);
while Source.Length > 1 loop
pragma Assert (Source.First in 1 .. Source.Capacity);
pragma Assert (Source.Last /= Source.First);
pragma Assert (N (Source.First).Prev = 0);
@ -1193,18 +1194,16 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
-- in the unbounded form of the doubly-linked list container. In that
-- case, Free is an instantation of Unchecked_Deallocation, which can
-- fail (because PE will be raised if controlled Finalize fails), so
-- we must defer the call until the very last step. Here in the
-- bounded form, Free merely links the node we have just
-- "deallocated" onto a list of inactive nodes, so technically Free
-- cannot fail. However, for consistency, we handle Free the same way
-- here as we do for the unbounded form, with the pessimistic
-- assumption that it can fail.
-- we must defer the call until the last step. Here in the bounded
-- form, Free merely links the node we have just "deallocated" onto a
-- list of inactive nodes, so technically Free cannot fail. However,
-- for consistency, we handle Free the same way here as we do for the
-- unbounded form, with the pessimistic assumption that it can fail.
Free (Source, X);
end loop;
if Source.Length = 1 then
pragma Assert (Source.First in 1 .. Source.Capacity);
pragma Assert (Source.Last = Source.First);
pragma Assert (N (Source.First).Prev = 0);
@ -1247,6 +1246,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
declare
Nodes : Node_Array renames Position.Container.Nodes;
Node : constant Count_Type := Nodes (Position.Node).Next;
begin
if Node = 0 then
return No_Element;

33
gcc/ada/a-cfdlli.adb
View File

@ -743,7 +743,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
begin
if Before.Node /= 0 then
null;
pragma Assert (Vet (Container, Before), "bad cursor in Insert");
end if;
@ -793,7 +792,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
begin
if Before.Node /= 0 then
null;
pragma Assert (Vet (Container, Before), "bad cursor in Insert");
end if;
@ -1008,7 +1006,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
Clear (Target);
while Source.Length > 1 loop
pragma Assert (Source.First in 1 .. Source.Capacity);
pragma Assert (Source.Last /= Source.First);
pragma Assert (N (Source.First).Prev = 0);
@ -1034,18 +1031,16 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
-- in the unbounded form of the doubly-linked list container. In that
-- case, Free is an instantation of Unchecked_Deallocation, which can
-- fail (because PE will be raised if controlled Finalize fails), so
-- we must defer the call until the very last step. Here in the
-- bounded form, Free merely links the node we have just
-- "deallocated" onto a list of inactive nodes, so technically Free
-- cannot fail. However, for consistency, we handle Free the same way
-- here as we do for the unbounded form, with the pessimistic
-- assumption that it can fail.
-- we must defer the call until the last step. Here in the bounded
-- form, Free merely links the node we have just "deallocated" onto a
-- list of inactive nodes, so technically Free cannot fail. However,
-- for consistency, we handle Free the same way here as we do for the
-- unbounded form, with the pessimistic assumption that it can fail.
Free (Source, X);
end loop;
if Source.Length = 1 then
pragma Assert (Source.First in 1 .. Source.Capacity);
pragma Assert (Source.Last = Source.First);
pragma Assert (N (Source.First).Prev = 0);
@ -1221,8 +1216,8 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
"attempt to tamper with cursors (list is locked)";
end if;
pragma Assert (Vet (Container, Position),
"bad cursor in Replace_Element");
pragma Assert
(Vet (Container, Position), "bad cursor in Replace_Element");
declare
N : Node_Array renames Container.Nodes;
@ -1421,7 +1416,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
begin
if Before.Node /= 0 then
null;
pragma Assert (Vet (Target, Before), "bad cursor in Splice");
end if;
@ -1513,17 +1507,16 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
begin
if Before.Node /= 0 then
null;
pragma Assert (Vet (Container, Before),
"bad Before cursor in Splice");
pragma Assert
(Vet (Container, Before), "bad Before cursor in Splice");
end if;
if Position.Node = 0 then
raise Constraint_Error with "Position cursor has no element";
end if;
pragma Assert (Vet (Container, Position),
"bad Position cursor in Splice");
pragma Assert
(Vet (Container, Position), "bad Position cursor in Splice");
if Position.Node = Before.Node
or else N (Position.Node).Next = Before.Node
@ -1732,8 +1725,8 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
raise Constraint_Error with "Position cursor has no element";
end if;
pragma Assert (Vet (Container, Position),
"bad cursor in Update_Element");
pragma Assert
(Vet (Container, Position), "bad cursor in Update_Element");
declare
B : Natural renames Container.Busy;

52
gcc/ada/exp_ch6.adb
View File

@ -1750,24 +1750,50 @@ package body Exp_Ch6 is
if not Is_Empty_List (Post_Call) then
-- If call is not a list member, it must be the triggering statement
-- of a triggering alternative or an entry call alternative, and we
-- can add the post call stuff to the corresponding statement list.
-- Cases where the call is not a member of a statement list
if not Is_List_Member (N) then
declare
P : constant Node_Id := Parent (N);
P : Node_Id := Parent (N);
begin
pragma Assert (Nkind_In (P, N_Triggering_Alternative,
N_Entry_Call_Alternative));
-- In Ada 2012 the call may be a function call in an expression
-- (since OUT and IN OUT parameters are now allowed for such
-- calls. The write-back of (in)-out parameters is handled
-- by the back-end, but the constraint checks generated when
-- subtypes of formal and actual don't match must be inserted
-- in the form of assignments, at the nearest point after the
-- declaration or statement that contains the call.
if Ada_Version >= Ada_2012
and then Nkind (N) = N_Function_Call
then
while Nkind (P) not in N_Declaration
and then
Nkind (P) not in N_Statement_Other_Than_Procedure_Call
loop
P := Parent (P);
end loop;
Insert_Actions_After (P, Post_Call);
-- If not the special Ada 2012 case of a function call, then
-- we must have the triggering statement of a triggering
-- alternative or an entry call alternative, and we can add
-- the post call stuff to the corresponding statement list.
if Is_Non_Empty_List (Statements (P)) then
Insert_List_Before_And_Analyze
(First (Statements (P)), Post_Call);
else
Set_Statements (P, Post_Call);
pragma Assert (Nkind_In (P, N_Triggering_Alternative,
N_Entry_Call_Alternative));
if Is_Non_Empty_List (Statements (P)) then
Insert_List_Before_And_Analyze
(First (Statements (P)), Post_Call);
else
Set_Statements (P, Post_Call);
end if;
end if;
end;
-- Otherwise, normal case where N is in a statement sequence,
@ -2764,7 +2790,7 @@ package body Exp_Ch6 is
Next_Formal (Formal);
end loop;
-- If we are calling an Ada2012 function which needs to have the
-- If we are calling an Ada 2012 function which needs to have the
-- "accessibility level determined by the point of call" (AI05-0234)
-- passed in to it, then pass it in.
@ -8506,8 +8532,8 @@ package body Exp_Ch6 is
return False;
-- Handle a corner case, a cross-dialect subp renaming. For example,
-- an Ada2012 renaming of an Ada05 subprogram. This can occur when a
-- non-Ada2012 unit references predefined runtime units.
-- an Ada 2012 renaming of an Ada 05 subprogram. This can occur when a
-- non-Ada 2012 unit references predefined run-time units.
elsif Present (Alias (Func_Id)) then

12
gcc/ada/gnat_ugn.texi
View File

@ -17889,6 +17889,9 @@ gnatmake -P<harness-dir>/test_driver
test_runner
@end smallexample
Note that you might need to specify the necessary values of scenario variables
when you are not using the AUnit defaults.
@item actual unit test stubs
a test stub for each visible subprogram is created in a separate file, if it
doesn't exist already. By default, those separate test files are located in a
@ -17899,6 +17902,9 @@ file my_unit.ads in directory src contains a visible subprogram Proc, then
the corresponding unit test will be found in file
src/tests/my_unit-tests-proc_<code>.adb. <code> is a signature encoding used to
differentiate test names in cases of overloading.
Note that if the project already has both my_unit.ads and my_unit-tests.ads this
will cause name a conflict with generated test package.
@end itemize
@node Switches for gnattest
@ -17921,6 +17927,10 @@ manual tests to be added to the test suite.
@cindex @option{-r} (@command{gnattest})
Recursively consider all sources from all projects.
@item -X@var{name=value}
@cindex @option{-X} (@command{gnattest})
Indicate that external variable @var{name} has the value @var{value}.
@item -q
@cindex @option{-q} (@command{gnattest})
Suppresses noncritical output messages.
@ -18311,6 +18321,8 @@ The tool currently does not support following features:
@item generic tests for generic packages and package instantiations
@item tests for protected subprograms and entries
@item aspects Precondition, Postcondition, and Test_Case
@item generating test packages for code that is not conformant with ada 2005
@end itemize
@c *********************************