[Ada] Missing constraint check on if-expression returning a string
authorEd Schonberg <schonberg@adacore.com>
Wed, 14 Nov 2018 11:41:58 +0000 (11:41 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Wed, 14 Nov 2018 11:41:58 +0000 (11:41 +0000)
commit1fc75ecf626b05733544bf9f67fb59fcd7322395
tree5098ddca40d7a18528fabd4c09693f9d6c51ec56
parentbfb1147ca896f985a2268b7b6a0ba4b36394f8cc
[Ada] Missing constraint check on if-expression returning a string

If the context of an if-expression is constrained, its dependent
expressions must obey the constraints of the expected type. Prior to
this patch, this check was performed only for scalar types, by means of
an added conversion.  This is now enforced on all types by means of a
qualified expression on each dependent expression.

Compiling ce.adb must yield:

  ce.adb:33:21: warning: string length wrong for type "T" defined at line 5
  ce.adb:33:21: warning: "Constraint_Error" will be raised at run time
  ce.adb:37:39: warning: string length wrong for type "T" defined at line 5
  ce.adb:37:39: warning: "Constraint_Error" will be raised at run time
  ce.adb:38:39: warning: too few elements for type "T" defined at line 5
  ce.adb:38:39: warning: "Constraint_Error" will be raised at run time
  ce.adb:39:39: warning: too few elements for type "T" defined at line 5
  ce.adb:39:39: warning: "Constraint_Error" will be raised at run time
----
with Text_IO;
procedure Ce is

  package Aerodrome_Identifier is
    subtype T is String (1 .. 4);
  end;

  package Flight_Identifier is
    type T is
     record
       ADEP                : Aerodrome_Identifier.T;
       Counter             : Positive;
     end record;
  end;

  procedure Assign (X : Flight_Identifier.T) is
  begin
    Text_IO.Put_Line (X.ADEP); -- outputs the 4 zero bytes
  end;

  function Env_Aerodrome_Value return String is ("ABCD");
  function Void return String is ("What?");
  function Void2 return String is
  begin
    return "who knows";
  end;
  Here : Aerodrome_Identifier.T;
  type Four is range 1 .. 4;
  Nothing : String := "";
begin
  Assign((ADEP =>
       (if (Void'Length = 5)
               then "" --!! This value should always raise Constraint_Error !!
                  else Env_Aerodrome_Value & "!"),
        Counter=> 17));

   Here := (if (Void'Length = 5) then "" else Env_Aerodrome_Value);
   Here := (if (Void'Length = 5) then Nothing else Env_Aerodrome_Value);
   Here := (if (Void'Length = 5) then Void2 (1..3) else Void2 & Void);
end;
----

2018-11-14  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

* sem_res.adb (Resolve_If_Expression): Verify that the subtypes
of all dependent expressions obey the constraints of the
expected type for the if-expression.
(Analyze_Expression): Only add qualificiation to the dependent
expressions when the context type is constrained. Small
adjustment to previous patch.

From-SVN: r266128
gcc/ada/ChangeLog
gcc/ada/sem_res.adb