diff options
author | Ed Schonberg <schonberg@adacore.com> | 2018-12-03 15:46:23 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2018-12-03 15:46:23 +0000 |
commit | 1ab144aec03080a93a59a180f5daae50143b006b (patch) | |
tree | d0bca3f0b2de69f0a3973f4d92c6c09ea61fdeb5 /gcc | |
parent | 7ed760c79399c2d0a3406f28c6fd85f95bf6097c (diff) | |
download | gcc-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/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/ada/sem_res.adb | 11 |
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); |