===================================================================
@@ -580,8 +580,27 @@
Set_Assignment_Type (Lhs, T1);
- Resolve (Rhs, T1);
+ -- If the target of the assignment is an entity of a mutable type
+ -- and the expression is a conditional expression, its alternatives
+ -- can be of different subtypes of the nominal type of the LHS, so
+ -- they must be resolved with the base type, given that their subtype
+ -- may differ frok that of the target mutable object.
+ if Is_Entity_Name (Lhs)
+ and then Ekind_In (Entity (Lhs),
+ E_Variable,
+ E_Out_Parameter,
+ E_In_Out_Parameter)
+ and then Is_Composite_Type (T1)
+ and then not Is_Constrained (Etype (Entity (Lhs)))
+ and then Nkind_In (Rhs, N_If_Expression, N_Case_Expression)
+ then
+ Resolve (Rhs, Base_Type (T1));
+
+ else
+ Resolve (Rhs, T1);
+ end if;
+
-- This is the point at which we check for an unset reference
Check_Unset_Reference (Rhs);
This patch fixes an error in an assignmen statement to an entity of a mutable type (variable or in-out parameter) when the righ-hand side of the assignment is a conditioal expression, some of whose alternatives are aggregates. Prior to this patch, not all components of the mutable object were properly assigned the corresponding values of the aggregate. Executing: gnatmake -q bug ./bug must yield: local var 72 local var 42 in_out parameter 72 in_out parameter 42 --- with Ada.Text_IO; procedure Bug is type Yoyo (Exists : Boolean := False) is record case Exists is when False => null; when True => Value : Integer := 5; end case; end record; Var1 : Yoyo; Var2 : Yoyo; procedure Test (Condition : in Boolean; Value : in Integer; Yo : in out Yoyo) is Var3 : Yoyo; begin Yo := (if Condition then (Exists => True, Value => Value) else (Exists => False)); Var3 := (case condition is when True => (Exists => True, Value => Value), when False => (Exists => False)); if Condition and then Yo.Value /= Value then Ada.Text_IO.Put_Line ("Compiler bug exposed"); end if; if Condition then Ada.Text_IO.Put_Line ("local var " & Integer'Image (Var3.Value)); end if; end; begin Test (True, 72, Var1); Test (True, 42, Var2); Ada.Text_IO.Put_Line ("in_out parameter " & Var1.Value'Img); Ada.Text_IO.Put_Line ("in_out parameter " & Var2.Value'Img); Test (False, 1000, Var1); end Bug; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-06 Ed Schonberg <schonberg@adacore.com> * sem_ch5.adb (Analyze_Assigment): If the left-hand side is an entity of a mutable type and the right-hand side is a conditional expression, resolve the alternatives of the conditional using the base type of the target entity, because the alternatives may have distinct subtypes. This is particularly relevant if the alternatives are aggregates.