]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
[Ada] Compiler failure on an extended_return_statement in a block
authorGary Dismukes <dismukes@adacore.com>
Tue, 31 Jul 2018 09:55:53 +0000 (09:55 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Tue, 31 Jul 2018 09:55:53 +0000 (09:55 +0000)
When compiling with an assertion-enabled compiler, Assert_Failure can be
raised when expanded an extended_return_statement whose enclosing scope
is not a function (such as when it's a block_statement). The simple fix
is to change the Assert to test Current_Subprogram rather than Current_Scope.
Three such Assert pragmas are corrected in this way.

2018-07-31  Gary Dismukes  <dismukes@adacore.com>

gcc/ada/

* exp_ch6.adb (Expand_N_Extended_Return_Statement): Replace
calls to Current_Scope in three assertions with calls to
Current_Subprogram.

gcc/testsuite/

* gnat.dg/block_ext_return_assert_failure.adb: New testcase.

From-SVN: r263096

gcc/ada/ChangeLog
gcc/ada/exp_ch6.adb
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/block_ext_return_assert_failure.adb [new file with mode: 0644]

index 8b286057c1c4e2e31b085246a2544bdb995ac711..f8da47c8fde5d68704ebb849efbef7f926ee8605 100644 (file)
@@ -1,3 +1,9 @@
+2018-07-31  Gary Dismukes  <dismukes@adacore.com>
+
+       * exp_ch6.adb (Expand_N_Extended_Return_Statement): Replace
+       calls to Current_Scope in three assertions with calls to
+       Current_Subprogram.
+
 2018-07-31  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_eval.adb (Check_Non_Static_Context): Do not warn on an
index 2ac5db67d54ce0b7b5ec3627180ceabd117fc009..f71cdab4703707fffd9a3c3f0873b6e09111a13e 100644 (file)
@@ -4763,7 +4763,7 @@ package body Exp_Ch6 is
       --  the pointer to the object) they are always handled by means of
       --  simple return statements.
 
-      pragma Assert (not Is_Thunk (Current_Scope));
+      pragma Assert (not Is_Thunk (Current_Subprogram));
 
       if Nkind (Ret_Obj_Decl) = N_Object_Declaration then
          Exp := Expression (Ret_Obj_Decl);
@@ -4772,9 +4772,9 @@ package body Exp_Ch6 is
          --  then F and G are both b-i-p, or neither b-i-p.
 
          if Nkind (Exp) = N_Function_Call then
-            pragma Assert (Ekind (Current_Scope) = E_Function);
+            pragma Assert (Ekind (Current_Subprogram) = E_Function);
             pragma Assert
-              (Is_Build_In_Place_Function (Current_Scope) =
+              (Is_Build_In_Place_Function (Current_Subprogram) =
                Is_Build_In_Place_Function_Call (Exp));
             null;
          end if;
index fd3079cf9079cdc5c326a1f8e81dda9d9fb985a0..2258aa25a0fb382bd0744086f43f16c2c748c75d 100644 (file)
@@ -1,3 +1,7 @@
+2018-07-31  Gary Dismukes  <dismukes@adacore.com>
+
+       * gnat.dg/block_ext_return_assert_failure.adb: New testcase.
+
 2018-07-31  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/iter3.adb: New testcase.
diff --git a/gcc/testsuite/gnat.dg/block_ext_return_assert_failure.adb b/gcc/testsuite/gnat.dg/block_ext_return_assert_failure.adb
new file mode 100644 (file)
index 0000000..afd66b3
--- /dev/null
@@ -0,0 +1,24 @@
+--  { dg-do compile }
+
+--  This test used to crash a compiler with assertions enabled
+
+procedure Block_Ext_Return_Assert_Failure is
+
+   function Return_Int return Integer is
+   begin
+      return 123;
+   end Return_Int;
+
+   function F return Integer is
+   begin
+      declare
+      begin
+         return Result : constant Integer := Return_Int do
+            null;
+         end return;
+      end;
+   end F;
+
+begin
+   null;
+end Block_Ext_Return_Assert_Failure;