[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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@266746 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 160ca997e8ee7e53475574672640fd69da696c0b..9bb341366b9dd633e5164972af864e952333d403 100644 (file)
--- 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 eb1709846fb1d18781454e4b09b17cb2535f61e6..b15be8e847b1eecf620d34602f453776313902b0 100644 (file)
--- 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);