aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorEd Schonberg <schonberg@adacore.com>2018-12-03 15:46:23 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2018-12-03 15:46:23 +0000
commit1ab144aec03080a93a59a180f5daae50143b006b (patch)
treed0bca3f0b2de69f0a3973f4d92c6c09ea61fdeb5 /gcc
parent7ed760c79399c2d0a3406f28c6fd85f95bf6097c (diff)
downloadgcc-1ab144aec03080a93a59a180f5daae50143b006b.zip
gcc-1ab144aec03080a93a59a180f5daae50143b006b.tar.gz
gcc-1ab144aec03080a93a59a180f5daae50143b006b.tar.bz2
[Ada] Missing check on if-expression
This patch fixes a constraint check on a dependent expression of an if-expression, when the context if given by a slice or the 'Range of an array. The constraint check is applied if the context is constrained, but the corresponding flag was not set for the index subtype generated for a slice (explicit or implicit). Executing: gprbuild -P test -q main ./main Must yield: raised CONSTRAINT_ERROR : foo.ads:13 range check failed ---- with Types; generic Buffer : in out Types.Buffer; package Foo is function Get (Pos : Natural) return Integer; private function Get (Pos : Natural) return Integer is (Buffer ((if Pos in Buffer'Range then Pos else Buffer'First))); end Foo; ---- with Foo; with Types; with Usefoo; procedure Main is Z : Types.Buffer := (Natural'Last .. Natural'Last - 1 => 0); R : Integer; begin Usefoo.Do_Something (Z, R); end Main; ---- pragma SPARK_Mode (On); pragma Profile (Ravenscar); pragma Partition_Elaboration_Policy (Sequential); ---- project Test is package Compiler is for Default_Switches ("Ada") use ("-gnatws"); for Local_Configuration_Pragmas use "test.adc"; end Compiler; end Test; ---- package Types is subtype Natural_Without_Last is Natural range 1 .. Natural'Last - 1; type Buffer is array (Natural_Without_Last range <>) of Integer; end Types; ---- with Foo; package body Usefoo is procedure Do_Something (B : in out Types.Buffer; R : out Integer) is package F is new Foo (B (B'First .. B'First + B'Length / 2 - 1)); begin R := F.Get (B'First + B'Length / 2 - 1); end Do_Something; end Usefoo; ---- with Types; package Usefoo is procedure Do_Something (B : in out Types.Buffer; R : out Integer) with Pre => B'First > 0; end Usefoo; 2018-12-03 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * sem_res.adb (Set_Slice_Subtype): The index type of a slice is constrained. From-SVN: r266746
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog5
-rw-r--r--gcc/ada/sem_res.adb11
2 files changed, 11 insertions, 5 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 160ca99..9bb3413 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2018-12-03 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_res.adb (Set_Slice_Subtype): The index type of a slice is
+ constrained.
+
2018-11-26 Matthias Klose <doko@ubuntu.com>
PR ada/88191
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index eb17098..b15be8e 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -11855,11 +11855,12 @@ package body Sem_Res is
-- for the subtype, but not in the context of a loop iteration
-- scheme).
- Set_Scalar_Range (Index_Subtype, New_Copy_Tree (Drange));
- Set_Parent (Scalar_Range (Index_Subtype), Index_Subtype);
- Set_Etype (Index_Subtype, Index_Type);
- Set_Size_Info (Index_Subtype, Index_Type);
- Set_RM_Size (Index_Subtype, RM_Size (Index_Type));
+ Set_Scalar_Range (Index_Subtype, New_Copy_Tree (Drange));
+ Set_Parent (Scalar_Range (Index_Subtype), Index_Subtype);
+ Set_Etype (Index_Subtype, Index_Type);
+ Set_Size_Info (Index_Subtype, Index_Type);
+ Set_RM_Size (Index_Subtype, RM_Size (Index_Type));
+ Set_Is_Constrained (Index_Subtype);
end if;
Slice_Subtype := Create_Itype (E_Array_Subtype, N);