From 6cdce5064b7e2c30beec8a99f1b19869f14398a7 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 31 Jul 2018 09:56:21 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/exp_ch6.adb | 24 ++++++++++++++++++++++++ gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/prot5.adb | 12 ++++++++++++ gcc/testsuite/gnat.dg/prot5_pkg.adb | 13 +++++++++++++ gcc/testsuite/gnat.dg/prot5_pkg.ads | 8 ++++++++ 6 files changed, 68 insertions(+) create mode 100644 gcc/testsuite/gnat.dg/prot5.adb create mode 100644 gcc/testsuite/gnat.dg/prot5_pkg.adb create mode 100644 gcc/testsuite/gnat.dg/prot5_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ccb8aa428af..e54c9e0bb7a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2018-07-31 Ed Schonberg + + * 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 * 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 f71cdab4703..224f4c76722 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 d7b99081f0d..6b4e6799d42 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-07-31 Ed Schonberg + + * gnat.dg/prot5.adb, gnat.dg/prot5_pkg.adb, + gnat.dg/prot5_pkg.ads: New testcase. + 2018-07-31 Justin Squirek * 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 00000000000..b7243a6341a --- /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 00000000000..58536c54f50 --- /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 00000000000..e488d09b78e --- /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; -- 2.30.2