[Ada] Missing predicate check on return value

The semantics of the return statement includes an implicit conversion of
the value to the return type of the funcction. This conversion, as
elsewhere, entails a predicate check if the return type has a predicate
aspect.

We do not apply the check to a case expression because in the context of
a return statement it will be expanded into a series of return
statements, each of which will receive a predicate check.

2018-09-26  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch6.adb (Analyze_Function_Return): If the return type has
	a dynamic_predicate, apply a Predicate_Check to the expression,
	given that it is implicitly converted to the return type.
	Exclude case expressions from the check, because in this context
	the expression is expanded into individual return statements.

gcc/testsuite/

	* gnat.dg/predicate3.adb, gnat.dg/predicate3_pkg.ads: New
	testcase.

From-SVN: r264611

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a0252f8d1afb31eb511201c8258c97039296844c..9db27470fe0e4df8c555af416a9e244cea747040 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2018-09-26  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch6.adb (Analyze_Function_Return): If the return type has
+       a dynamic_predicate, apply a Predicate_Check to the expression,
+       given that it is implicitly converted to the return type.
+       Exclude case expressions from the check, because in this context
+       the expression is expanded into individual return statements.
+
 2018-09-26  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Task_Type>: In

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index b330426db5cbef9dcadd4ecd17a32621df994950..d0617fe50b9f4a36053c13141ace089fe0655155 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -1060,6 +1060,16 @@ package body Sem_Ch6 is
 
          Apply_Constraint_Check (Expr, R_Type);
 
+         --  The return value is converted to the return type of the function,
+         --  which implies a predicate check if the return type is predicated.
+         --  We do not apply the check to a case expression because it will
+         --  be expanded into a series of return statements, each of which
+         --  will receive a predicate check.
+
+         if Nkind (Expr) /= N_Case_Expression then
+            Apply_Predicate_Check (Expr, R_Type);
+         end if;
+
          --  Ada 2005 (AI-318-02): When the result type is an anonymous access
          --  type, apply an implicit conversion of the expression to that type
          --  to force appropriate static and run-time accessibility checks.

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c97b9c509ee8e1f339ac05a6855cd7f6fc70180d..3c954322f59c28c3e414c11da61bf75d2bf865f4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-09-26  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/predicate3.adb, gnat.dg/predicate3_pkg.ads: New
+       testcase.
+
 2018-09-26  Paolo Carlini  <paolo.carlini@oracle.com>
 
        PR c++/67656

diff --git a/gcc/testsuite/gnat.dg/predicate3.adb b/gcc/testsuite/gnat.dg/predicate3.adb
new file mode 100644 (file)
index 0000000..0d649ed
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/predicate3.adb
@@ -0,0 +1,39 @@
+--  { dg-do run }
+--  { dg-options "-gnata" }
+
+with Ada.Assertions, Ada.Text_IO;
+use  Ada.Assertions, Ada.Text_IO;
+
+with Predicate3_Pkg;
+use  Predicate3_Pkg;
+
+procedure Predicate3 is
+   Got_Assertion : Boolean := False;
+begin
+
+   begin
+      Put_Line (Good (C)'Image);
+   exception
+      when Assertion_Error =>
+         Got_Assertion := True;
+   end;
+
+   if not Got_Assertion then
+      raise Program_Error;
+   end if;
+
+   Got_Assertion := False;
+   declare
+      X: Priv;
+   begin
+      X := Wrong;
+   exception
+      when Assertion_Error =>
+         Got_Assertion := True;
+   end;
+
+   if not Got_Assertion then
+      raise Program_Error;
+   end if;
+
+end Predicate3;

diff --git a/gcc/testsuite/gnat.dg/predicate3_pkg.ads b/gcc/testsuite/gnat.dg/predicate3_pkg.ads
new file mode 100644 (file)
index 0000000..a5c2e4c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/predicate3_pkg.ads
@@ -0,0 +1,22 @@
+package Predicate3_Pkg is
+ 
+   type Priv is private;
+   C: constant Priv;
+ 
+   function Test (X: Priv) return Boolean;
+   subtype Subt is Priv with Dynamic_Predicate => (Test (Subt));
+ 
+   function Wrong return Subt;
+   function Good (X: Subt) return Boolean;
+ 
+private
+ 
+   type Priv is new Integer;
+   C: constant Priv := -1;
+ 
+   function Test (X: Priv) return Boolean is (X > 0);
+ 
+   function Wrong return Subt is (-1);
+   function Good (X: Subt) return Boolean is (True);
+ 
+end Predicate3_Pkg;