This patch corrects an oversight in the computation of size of multidimensional
packed arrays. Previously to this patch only the first dimension was used
to determine the number of storage units to compare.
Executing
gnatmake -q equality.adb
equality
must yield
Success - comparison claims these are different
---
with ADA.TEXT_IO;
procedure EQUALITY is
type FLAG_TYPE is (RED, GREEN);
for FLAG_TYPE'size use 1;
type TWO_DIM_ARRAY_TYPE is array
(INTEGER range 1 .. 16, INTEGER range 1 .. 16) of FLAG_TYPE;
pragma PACK(TWO_DIM_ARRAY_TYPE);
ARR_1 : TWO_DIM_ARRAY_TYPE := (others => (others => RED));
ARR_2 : TWO_DIM_ARRAY_TYPE := (others => (others => RED));
begin
ARR_2(2,1) := GREEN; -- Make the two arrays different.
if ARR_1 /= ARR_2
then
ADA.TEXT_IO.PUT_LINE("Success - comparison claims these are different");
else
ADA.TEXT_IO.PUT_LINE("Failure - comparison claims these are identical");
end if;
end EQUALITY;
Tested on x86_64-pc-linux-gnu, committed on trunk
2016-04-21 Ed Schonberg <schonb...@adacore.com>
* exp_pakd.adb (Compute_Number_Components): New function to
build an expression that computes the number of a components of
an array that may be multidimensional.
(Expan_Packed_Eq): Use it.
Index: exp_pakd.adb
===================================================================
--- exp_pakd.adb (revision 235192)
+++ exp_pakd.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -81,6 +81,12 @@
-- Local Subprograms --
-----------------------
+ function Compute_Number_Components
+ (N : Node_Id;
+ Typ : Entity_Id) return Node_Id;
+ -- Build an expression that multiplies the length of the dimensions of the
+ -- array, used to control array equality checks.
+
procedure Compute_Linear_Subscript
(Atyp : Entity_Id;
N : Node_Id;
@@ -260,6 +266,38 @@
return Adjusted;
end Revert_Storage_Order;
+ -------------------------------
+ -- Compute_Number_Components --
+ -------------------------------
+
+ function Compute_Number_Components
+ (N : Node_Id;
+ Typ : Entity_Id) return Node_Id
+ is
+ Loc : constant Source_Ptr := Sloc (N);
+ Len_Expr : Node_Id;
+
+ begin
+ Len_Expr :=
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Length,
+ Prefix => New_Occurrence_Of (Typ, Loc),
+ Expressions => New_List (Make_Integer_Literal (Loc, 1)));
+
+ for J in 2 .. Number_Dimensions (Typ) loop
+ Len_Expr :=
+ Make_Op_Multiply (Loc,
+ Left_Opnd => Len_Expr,
+ Right_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Length,
+ Prefix => New_Occurrence_Of (Typ, Loc),
+ Expressions => New_List (Make_Integer_Literal (Loc, J))));
+ end loop;
+
+ return Len_Expr;
+ end Compute_Number_Components;
+
------------------------------
-- Compute_Linear_Subscript --
------------------------------
@@ -451,7 +489,6 @@
PASize : Uint;
Decl : Node_Id;
PAT : Entity_Id;
- Len_Dim : Node_Id;
Len_Expr : Node_Id;
Len_Bits : Uint;
Bits_U1 : Node_Id;
@@ -811,35 +848,8 @@
-- Build an expression for the length of the array in bits.
-- This is the product of the length of each of the dimensions
- declare
- J : Nat := 1;
+ Len_Expr := Compute_Number_Components (Typ, Typ);
- begin
- Len_Expr := Empty; -- suppress junk warning
-
- loop
- Len_Dim :=
- Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Length,
- Prefix => New_Occurrence_Of (Typ, Loc),
- Expressions => New_List (
- Make_Integer_Literal (Loc, J)));
-
- if J = 1 then
- Len_Expr := Len_Dim;
-
- else
- Len_Expr :=
- Make_Op_Multiply (Loc,
- Left_Opnd => Len_Expr,
- Right_Opnd => Len_Dim);
- end if;
-
- J := J + 1;
- exit when J > Number_Dimensions (Typ);
- end loop;
- end;
-
-- Temporarily attach the length expression to the tree and analyze
-- and resolve it, so that we can test its value. We assume that the
-- total length fits in type Integer. This expression may involve
@@ -1872,19 +1882,12 @@
LLexpr :=
Make_Op_Multiply (Loc,
- Left_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Ltyp, Loc),
- Attribute_Name => Name_Length),
- Right_Opnd =>
- Make_Integer_Literal (Loc, Component_Size (Ltyp)));
+ Left_Opnd => Compute_Number_Components (N, Ltyp),
+ Right_Opnd => Make_Integer_Literal (Loc, Component_Size (Ltyp)));
RLexpr :=
Make_Op_Multiply (Loc,
- Left_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Rtyp, Loc),
- Attribute_Name => Name_Length),
+ Left_Opnd => Compute_Number_Components (N, Rtyp),
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Rtyp)));
