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/ada/gcc-interface/misc.c | |
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/ada/gcc-interface/misc.c')
0 files changed, 0 insertions, 0 deletions