aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2011-11-21 11:22:47 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2011-11-21 11:22:47 +0000
commite6a29bf11a0c3ae421df88c384806e7d1b549142 (patch)
treed7c262a43cb5289678f60e01f197e231069e0715
parent4b0d06894ec17581f19b592a6bcdd54b6d0cfbd4 (diff)
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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@181559 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/ada/ChangeLog16
-rw-r--r--gcc/ada/a-cbdlli.adb18
-rw-r--r--gcc/ada/a-cfdlli.adb33
-rw-r--r--gcc/ada/exp_ch6.adb52
-rw-r--r--gcc/ada/gnat_ugn.texi12
5 files changed, 89 insertions, 42 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 22f5712ceee..003a23e22ab 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/a-cbdlli.adb b/gcc/ada/a-cbdlli.adb
index 9e400715940..5a3169eee50 100644
--- a/gcc/ada/a-cbdlli.adb
+++ b/gcc/ada/a-cbdlli.adb
@@ -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
- while Source.Length > 1 loop
+ 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;
diff --git a/gcc/ada/a-cfdlli.adb b/gcc/ada/a-cfdlli.adb
index d1bd218972d..3c73c0467aa 100644
--- a/gcc/ada/a-cfdlli.adb
+++ b/gcc/ada/a-cfdlli.adb
@@ -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;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 227f72921be..b68fb8af909 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -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
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 253cfff172b..b30136d8e40 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -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 *********************************