aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEd Schonberg <schonberg@adacore.com>2018-07-31 09:56:21 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2018-07-31 09:56:21 +0000
commit6cdce5064b7e2c30beec8a99f1b19869f14398a7 (patch)
treea9c4a33556cefd3b66bc8a316f84ce245d638003
parentc992e2e4bd68729e7849c5649a9492263aedc063 (diff)
downloadgcc-6cdce5064b7e2c30beec8a99f1b19869f14398a7.zip
gcc-6cdce5064b7e2c30beec8a99f1b19869f14398a7.tar.gz
gcc-6cdce5064b7e2c30beec8a99f1b19869f14398a7.tar.bz2
[Ada] Spurious error on default parameter in protected operation
This patch fixes a spurious compiler error on a call to a protected operation whose profile includes a defaulted in-parameter that is a call to another protected function of the same object. 2018-07-31 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * exp_ch6.adb (Expand_Protected_Subprogram_Call): Handle properly a protected call that includes a default parameter that is a call to a protected function of the same type. gcc/testsuite/ * gnat.dg/prot5.adb, gnat.dg/prot5_pkg.adb, gnat.dg/prot5_pkg.ads: New testcase. From-SVN: r263101
-rw-r--r--gcc/ada/ChangeLog6
-rw-r--r--gcc/ada/exp_ch6.adb24
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gnat.dg/prot5.adb12
-rw-r--r--gcc/testsuite/gnat.dg/prot5_pkg.adb13
-rw-r--r--gcc/testsuite/gnat.dg/prot5_pkg.ads8
6 files changed, 68 insertions, 0 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ccb8aa4..e54c9e0 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2018-07-31 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch6.adb (Expand_Protected_Subprogram_Call): Handle
+ properly a protected call that includes a default parameter that
+ is a call to a protected function of the same type.
+
2018-07-31 Justin Squirek <squirek@adacore.com>
* lib-writ.adb (Write_With_Lines): Modfiy the generation of
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index f71cdab..224f4c7 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -6387,6 +6387,30 @@ package body Exp_Ch6 is
then
Rec := New_Occurrence_Of (First_Entity (Current_Scope), Sloc (N));
+ -- A default parameter of a protected operation may be a call to
+ -- a protected function of the type. This appears as an internal
+ -- call in the profile of the operation, but if the context is an
+ -- external call we must convert the call into an external one,
+ -- using the protected object that is the target, so that:
+
+ -- Prot.P (F)
+ -- is transformed into
+ -- Prot.P (Prot.F)
+
+ elsif Nkind (Parent (N)) = N_Procedure_Call_Statement
+ and then Nkind (Name (Parent (N))) = N_Selected_Component
+ and then Is_Protected_Type (Etype (Prefix (Name (Parent (N)))))
+ and then Is_Entity_Name (Name (N))
+ and then Scope (Entity (Name (N))) =
+ Etype (Prefix (Name (Parent (N))))
+ then
+ Rewrite (Name (N),
+ Make_Selected_Component (Sloc (N),
+ Prefix => New_Copy_Tree (Prefix (Name (Parent (N)))),
+ Selector_Name => Relocate_Node (Name (N))));
+ Analyze_And_Resolve (N);
+ return;
+
else
-- If the context is the initialization procedure for a protected
-- type, the call is legal because the called entity must be a
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d7b9908..6b4e679 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-07-31 Ed Schonberg <schonberg@adacore.com>
+
+ * gnat.dg/prot5.adb, gnat.dg/prot5_pkg.adb,
+ gnat.dg/prot5_pkg.ads: New testcase.
+
2018-07-31 Justin Squirek <squirek@adacore.com>
* gnat.dg/addr11.adb: New testcase.
diff --git a/gcc/testsuite/gnat.dg/prot5.adb b/gcc/testsuite/gnat.dg/prot5.adb
new file mode 100644
index 0000000..b7243a6
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/prot5.adb
@@ -0,0 +1,12 @@
+-- { dg-do run }
+-- { dg-options -gnata }
+
+with Prot5_Pkg;
+
+procedure Prot5 is
+begin
+ Prot5_Pkg.P.Proc (10); -- explicit parameter
+ Prot5_Pkg.P.Proc (Prot5_Pkg.P.Get_Data); -- explicit call to protected operation
+ Prot5_Pkg.P.Proc; -- defaulted call.
+ pragma Assert (Prot5_Pkg.P.Get_Data = 80);
+end Prot5;
diff --git a/gcc/testsuite/gnat.dg/prot5_pkg.adb b/gcc/testsuite/gnat.dg/prot5_pkg.adb
new file mode 100644
index 0000000..58536c5
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/prot5_pkg.adb
@@ -0,0 +1,13 @@
+package body Prot5_Pkg is
+ protected body P is
+ function Get_Data return Integer is
+ begin
+ return Data;
+ end Get_Data;
+
+ procedure Proc (A : Integer := Get_Data) is
+ begin
+ Data := A * 2;
+ end Proc;
+ end P;
+end Prot5_Pkg;
diff --git a/gcc/testsuite/gnat.dg/prot5_pkg.ads b/gcc/testsuite/gnat.dg/prot5_pkg.ads
new file mode 100644
index 0000000..e488d09
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/prot5_pkg.ads
@@ -0,0 +1,8 @@
+package Prot5_Pkg is
+ protected P is
+ function Get_Data return Integer;
+ procedure Proc (A : Integer := Get_Data);
+ private
+ Data : Integer;
+ end P;
+end Prot5_Pkg;