]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
[Ada] Crash on expression functions within quantified expressions
authorJustin Squirek <squirek@adacore.com>
Wed, 26 Sep 2018 09:17:21 +0000 (09:17 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Wed, 26 Sep 2018 09:17:21 +0000 (09:17 +0000)
This patch fixes an issue whereby using a call to an expression function
as the domain of iteration for a loop would trigger a crash due to the
function not being frozen appropriately.

2018-09-26  Justin Squirek  <squirek@adacore.com>

gcc/ada/

* sem_ch5.adb (Analyze_Iterator_Specification): Add conditional
to freeze called functions within iterator specifications during
full analysis.
(Preanalyze_Range): Minor typo fix.

gcc/testsuite/

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

From-SVN: r264612

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

index 9db27470fe0e4df8c555af416a9e244cea747040..4ab1bcd54aaff971cad222f9d8857815fba10e18 100644 (file)
@@ -1,3 +1,10 @@
+2018-09-26  Justin Squirek  <squirek@adacore.com>
+
+       * sem_ch5.adb (Analyze_Iterator_Specification): Add conditional
+       to freeze called functions within iterator specifications during
+       full analysis.
+       (Preanalyze_Range): Minor typo fix.
+
 2018-09-26  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_ch6.adb (Analyze_Function_Return): If the return type has
index f35b37d9c36bbf821361936fad8d6b5cd017daf4..2f4469133500f91d013ddd9e6d1e1760527e2c6b 100644 (file)
@@ -2203,6 +2203,19 @@ package body Sem_Ch5 is
 
       Preanalyze_Range (Iter_Name);
 
+      --  If the domain of iteration is a function call, make sure the function
+      --  itself is frozen. This is an issue if this is a local expression
+      --  function.
+
+      if Nkind (Iter_Name) = N_Function_Call
+        and then Is_Entity_Name (Name (Iter_Name))
+        and then Full_Analysis
+        and then (In_Assertion_Expr = 0
+                   or else Assertions_Enabled)
+      then
+         Freeze_Before (N, Entity (Name (Iter_Name)));
+      end if;
+
       --  Set the kind of the loop variable, which is not visible within the
       --  iterator name.
 
@@ -4136,10 +4149,10 @@ package body Sem_Ch5 is
       Full_Analysis := False;
       Expander_Mode_Save_And_Set (False);
 
-      --  In addition to the above we must ecplicity suppress the
-      --  generation of freeze nodes which might otherwise be generated
-      --  during resolution of the range (e.g. if given by an attribute
-      --  that will freeze its prefix).
+      --  In addition to the above we must explicitly suppress the generation
+      --  of freeze nodes that might otherwise be generated during resolution
+      --  of the range (e.g. if given by an attribute that will freeze its
+      --  prefix).
 
       Set_Must_Not_Freeze (R_Copy);
 
index 3c954322f59c28c3e414c11da61bf75d2bf865f4..f8591aa6db977b546d41af2fc2d2a3a585e74f46 100644 (file)
@@ -1,3 +1,7 @@
+2018-09-26  Justin Squirek  <squirek@adacore.com>
+
+       * gnat.dg/expr_func8.adb: New testcase.
+
 2018-09-26  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/predicate3.adb, gnat.dg/predicate3_pkg.ads: New
diff --git a/gcc/testsuite/gnat.dg/expr_func8.adb b/gcc/testsuite/gnat.dg/expr_func8.adb
new file mode 100644 (file)
index 0000000..90d3c93
--- /dev/null
@@ -0,0 +1,37 @@
+--  { dg-do compile }
+--  { dg-options "-gnata" }
+
+procedure Expr_Func8 is
+
+   type Node_Set is array (Positive range <>) of Integer;
+
+   function Nodes return Node_Set is
+     ((1,2,3,4,5,6,7,8,9));
+
+   X1 : Boolean := (for all N of Nodes => N = N);
+
+   function Predecessors (N : Integer) return Node_Set Is
+      (Nodes (1 .. N - 1));
+   function Successors (N : Integer) return Node_Set Is
+      (Nodes (N + 1 .. Nodes'Last));
+
+   pragma Assert
+     (for all N of Nodes =>
+       (for some S of Successors (N) => S = N));
+
+   X2 : Boolean :=
+     (for all N of Nodes =>
+       (for some S of Successors (N) => S = N));
+
+   X3 : Boolean :=
+     (for all N of Nodes =>
+       (for some S of Successors (N) => S = N)) with Ghost;
+
+   pragma Assert
+      (for all N of Nodes =>
+      (for all P of Predecessors (N) =>
+      (for some S of Successors (P) => S = N)));
+
+begin
+   null;
+end;