This patch fixes a crash on a variable indexing operation appearing on the
left-hand side of an assignment, when the index expressions are given by
parameter associations.
The following must compile quietly:
gcc -c -gnatct test_indexing.adb
---
with Ada.Text_IO; use Ada.Text_IO;
with Project; use Project;
with Matrix_3x3s; use Matrix_3x3s;
with Vector_3s; use Vector_3s;
procedure Test_Indexing is
V : Vector_3 := Create (X => 12.34,
Y => 123.4,
Z => 1234.0);
M : Matrix_3x3 := (Create (X => V,
Y => V * 2.0,
Z => V * 4.0));
Idx1 : Integer := 1;
type Arr_Type is array (1 .. 10) of Integer;
Arr : Arr_Type;
begin
M (X => Idx1, Y=>1) := 20.0;
M (Idx1, 2) := 20.0;
M (1, 1) := 20.0;
Arr (1) := 10;
end Test_Indexing;
---
with Project; use Project;
with Project.Real_Arrays; use Project.Real_Arrays;
with Vector_3s; use Vector_3s;
package Matrix_3x3s is
pragma Pure (Matrix_3x3s);
subtype An_Axis is Integer range 1 .. 3;
type Matrix_3x3 is tagged private
with Constant_Indexing => Matrix_3x3s.Constant_Reference,
Variable_Indexing => Matrix_3x3s.Variable_Reference;
function Create (X, Y, Z : Vector_3) return Matrix_3x3;
type Constant_Reference_Type (Value : not null access constant Real) is
private with Implicit_Dereference => Value;
function Constant_Reference (This : Matrix_3x3;
X, Y : An_Axis) return Constant_Reference_Type;
type Reference_Type (Value : not null access Real) is
private with Implicit_Dereference => Value;
function Variable_Reference (This : Matrix_3x3;
X, Y : An_Axis) return Reference_Type;
private
type Matrix_3x3 is tagged record
M : Real_Matrix (An_Axis, An_Axis);
end record;
function Create (X, Y, Z : Vector_3) return Matrix_3x3 is
(M => (1 => (X.Get_X, X.Get_Y, X.Get_Z),
2 => (Y.Get_X, Y.Get_Y, Y.Get_Z),
3 => (Z.Get_X, Z.Get_Y, Z.Get_Z)));
type Constant_Reference_Type (Value : not null access constant Real) is
null record;
type Reference_Type (Value : not null access Real) is
null record;
function Constant_Reference (This : Matrix_3x3;
X, Y : An_Axis)
return Constant_Reference_Type is
(Value => This.M (X, Y)'Unrestricted_Access);
function Variable_Reference (This : Matrix_3x3;
X, Y : An_Axis)
return Reference_Type is
(Value => This.M (X, Y)'Unrestricted_Access);
end Matrix_3x3s;
---
with Ada.Numerics.Long_Real_Arrays;
package Project.Real_Arrays
renames Ada.Numerics.Long_Real_Arrays;
package Project is
pragma Pure (Project);
subtype Real is Long_Float;
pragma Assert (Real'Size >= 64);
subtype Non_Negative_Real is Real range 0.0 .. Real'Last;
subtype Positive_Real is Real range Real'Succ (0.0) .. Real'Last;
end Project;
---
with Project; use Project;
with Project.Real_Arrays; use Project.Real_Arrays;
package Vector_3s is
pragma Pure (Vector_3s);
subtype An_Axis is Integer range 1 .. 3;
type Vector_3 is tagged private
with Constant_Indexing => Vector_3s.Constant_Reference,
Variable_Indexing => Vector_3s.Variable_Reference;
function Create (X, Y, Z : Real) return Vector_3;
function Get_X (This : Vector_3) return Real;
function Get_Y (This : Vector_3) return Real;
function Get_Z (This : Vector_3) return Real;
function "*" (Left : Vector_3;
Right : Real'Base)
return Vector_3;
subtype Real_Vector_3 is Real_Vector (An_Axis);
type Constant_Reference_Type (Value : not null access constant Real) is
private with Implicit_Dereference => Value;
function Constant_Reference (This : Vector_3;
Axis : An_Axis)
return Constant_Reference_Type;
type Reference_Type (Value : not null access Real) is
private with Implicit_Dereference => Value;
function Variable_Reference (This : Vector_3;
Axis : An_Axis)
return Reference_Type;
private
type Vector_3 is tagged record
V : Real_Vector (An_Axis);
end record;
function Create (X, Y, Z : Real) return Vector_3 is
(V => (1 => X, 2 => Y, 3 => Z));
function Get_X (This : Vector_3) return Real is
(This.V (1));
function Get_Y (This : Vector_3) return Real is
(This.V (2));
function Get_Z (This : Vector_3) return Real is
(This.V (3));
function "*" (Left : Vector_3; Right : Real'Base) return Vector_3 is
(V => Left.V * Right);
type Constant_Reference_Type (Value : not null access constant Real) is
null record;
type Reference_Type (Value : not null access Real) is
null record;
function Constant_Reference (This : Vector_3;
Axis : An_Axis)
return Constant_Reference_Type is
(Value => This.V (Axis)'Unrestricted_Access);
function Variable_Reference (This : Vector_3;
Axis : An_Axis)
return Reference_Type is
(Value => This.V (Axis)'Unrestricted_Access);
end Vector_3s;
Tested on x86_64-pc-linux-gnu, committed on trunk
2015-11-18 Ed Schonberg <schonb...@adacore.com>
* sem_ch4.adb (Try_Container_Indexing): When constructing the
parameter list for the potentially overloaded calls to indexing
functions, do not propagate overloadings if the actual is a named
association: overloadings appear directly on the expression in
the association.
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 230524)
+++ sem_ch4.adb (working copy)
@@ -7437,7 +7437,14 @@
Arg := First (Exprs);
while Present (Arg) loop
New_Arg := Relocate_Node (Arg);
- Save_Interps (Arg, New_Arg);
+
+ -- The arguments can be parameter associations, in which case the
+ -- explicit actual parameter carries the overloadings.
+
+ if Nkind (New_Arg) /= N_Parameter_Association then
+ Save_Interps (Arg, New_Arg);
+ end if;
+
Append (New_Arg, Assoc);
Next (Arg);
end loop;
