r266128 - in /trunk/gcc/ada: ChangeLog sem_res.adb

[pmderodat@gcc.gnu.org]

Author: pmderodat
Date: Wed Nov 14 11:41:58 2018
New Revision: 266128

URL: https://gcc.gnu.org/viewcvs?rev=266128&root=gcc&view=rev
Log:
[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.

Modified:
    trunk/gcc/ada/ChangeLog
    trunk/gcc/ada/sem_res.adb