This change adds circuitry to identify some bit packed arrays that are known at compile time to exceed the maximum size supported by the implementation.
The following compilation must be rejected with the indicated error message: $ gcc large_bit_packed_array.ads large_bit_packed_array.ads:2:09: bit packed array type may not have more than Integer'Last+1 elements package Large_Bit_Packed_Array is type A is array (Integer) of Boolean; pragma Pack (A); end Large_Bit_Packed_Array; Tested on x86_64-pc-linux-gnu, committed on trunk 2013-04-23 Thomas Quinot <qui...@adacore.com> * freeze.adb (Freeze_Entity): For the case of a bit-packed array time that is known at compile time to have more that Integer'Last+1 elements, issue an error, since such arrays are not supported.
Index: freeze.adb =================================================================== --- freeze.adb (revision 198175) +++ freeze.adb (working copy) @@ -3913,27 +3913,92 @@ end if; end if; - -- For bit-packed arrays, check the size + -- Specific checks for bit-packed arrays - if Is_Bit_Packed_Array (E) and then Known_RM_Size (E) then - declare - SizC : constant Node_Id := Size_Clause (E); + if Is_Bit_Packed_Array (E) then - Discard : Boolean; - pragma Warnings (Off, Discard); + -- Check number of elements for bit packed arrays that come + -- from source and have compile time known ranges. The + -- bit-packed arrays circuitry does not support arrays + -- with more than Integer'Last + 1 elements, and when this + -- restriction is violated, causes incorrect data access. - begin - -- It is not clear if it is possible to have no size - -- clause at this stage, but it is not worth worrying - -- about. Post error on the entity name in the size - -- clause if present, else on the type entity itself. + -- For the case where this is not compile time known, a + -- run-time check should be generated??? - if Present (SizC) then - Check_Size (Name (SizC), E, RM_Size (E), Discard); - else - Check_Size (E, E, RM_Size (E), Discard); - end if; - end; + if Comes_From_Source (E) and then Is_Constrained (E) then + declare + Elmts : Uint; + Index : Node_Id; + Ilen : Node_Id; + Ityp : Entity_Id; + + begin + Elmts := Uint_1; + Index := First_Index (E); + while Present (Index) loop + Ityp := Etype (Index); + + -- Never generate an error if any index is of a + -- generic type. We will check this in instances. + + if Is_Generic_Type (Ityp) then + Elmts := Uint_0; + exit; + end if; + + Ilen := + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (Ityp, Loc), + Attribute_Name => Name_Range_Length); + Analyze_And_Resolve (Ilen); + + -- No attempt is made to check number of elements + -- if not compile time known. + + if Nkind (Ilen) /= N_Integer_Literal then + Elmts := Uint_0; + exit; + end if; + + Elmts := Elmts * Intval (Ilen); + Next_Index (Index); + end loop; + + if Elmts > Intval (High_Bound + (Scalar_Range + (Standard_Integer))) + 1 + then + Error_Msg_N + ("bit packed array type may not have " + & "more than Integer''Last+1 elements", E); + end if; + end; + end if; + + -- Check size + + if Known_RM_Size (E) then + declare + SizC : constant Node_Id := Size_Clause (E); + + Discard : Boolean; + pragma Warnings (Off, Discard); + + begin + -- It is not clear if it is possible to have no size + -- clause at this stage, but it is not worth worrying + -- about. Post error on the entity name in the size + -- clause if present, else on the type entity itself. + + if Present (SizC) then + Check_Size (Name (SizC), E, RM_Size (E), Discard); + else + Check_Size (E, E, RM_Size (E), Discard); + end if; + end; + end if; end if; -- If any of the index types was an enumeration type with a