From 4f469dec551ee19b81d9486e587ebb4945a92948 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Fri, 5 Jul 2019 07:03:05 +0000 Subject: [PATCH] [Ada] Missing range check on assignment to bit-packed array This patch adds an explicit range check on an assignment to a component of a bit-packed array, when the index type of the array is an enumeration type with a non-standard representation, Executing the following: gnatmake -f -gnata -q main ./main must yield: 1 is invalid 4097 is invalid 4116 is invalid 4117 is invalid 4118 is invalid 4119 is invalid 4120 is invalid 4121 is invalid ---- with Example; use Example; with My_Types; use My_Types; with Text_IO; use Text_IO; procedure main is begin --We try to access an invalid array location. begin dummy(idx => 1, action => DISABLE); exception when others => Text_IO.Put_Line ("1 is invalid"); end; for I in typ_uint32'(16#1000#) .. 16#101E# loop declare begin -- Text_IO.Put_Line (typ_uint32'image(I) & " OK"); Dummy (Idx => I, action => Enable); exception when others => put_line (typ_uint32'Image (I) & " is invalid"); end; end loop; end; ---- with Interfaces; use Interfaces; package My_Types is subtype typ_bool is boolean; type typ_uint32 is new Interfaces.Unsigned_32; subtype typ_uint16 is typ_uint32 range 0..2**16 - 1; type typ_dis_en is ( DISABLE, ENABLE ); for typ_dis_en'size use 32; for typ_dis_en use ( DISABLE => 0, ENABLE => 1 ); type typ_rid is ( RID_0, RID_2, RID_3, RID_4, RID_5, RID_6, RID_7, RID_8, RID_9, RID_10, RID_11, RID_12, RID_13, RID_14, RID_15, RID_16, RID_17, RID_18, RID_19, RID_26, RID_27, RID_28, RID_29, RID_30 ); for typ_rid use ( RID_0 => 16#1000#, RID_2 => 16#1002#, RID_3 => 16#1003#, RID_4 => 16#1004#, RID_5 => 16#1005#, RID_6 => 16#1006#, RID_7 => 16#1007#, RID_8 => 16#1008#, RID_9 => 16#1009#, RID_10 => 16#100A#, RID_11 => 16#100B#, RID_12 => 16#100C#, RID_13 => 16#100D#, RID_14 => 16#100E#, RID_15 => 16#100F#, RID_16 => 16#1010#, RID_17 => 16#1011#, RID_18 => 16#1012#, RID_19 => 16#1013#, RID_26 => 16#101A#, RID_27 => 16#101B#, RID_28 => 16#101C#, RID_29 => 16#101D#, RID_30 => 16#101E# ); for typ_rid'size use 16; end My_Types; ---- with My_Types; package Example is procedure Check; procedure dummy ( idx : in My_Types.typ_uint32; action : in My_Types.typ_dis_en ); end Example; ---- with Text_IO; use Text_IO; with Unchecked_Conversion; with my_types; use my_types; package body Example is type typ_rid_sts is array (My_Types.typ_rid) of My_Types.typ_bool; for typ_rid_sts'component_size use 1; is_rid_en : typ_rid_sts := (TRUE, false, True, False, true, False, True, false, True, False, TRUE, false, True, False, true, False, True, false, True, False, TRUE, false, True, False); procedure Check is begin pragma Assert (for all I in is_rid_en'range => is_rid_en (I)); end Check; function toRidEvt is new Unchecked_Conversion ( -- Defining source and target types source => My_Types.typ_uint16, target => My_Types.typ_rid ); procedure dummy ( idx : in My_Types.typ_uint32; action : in My_Types.typ_dis_en) is rid_evt : My_Types.typ_rid; begin rid_evt := toRidEvt(idx); if action = My_Types.ENABLE then is_rid_en(rid_evt) := TRUE; else is_rid_en(rid_evt) := FALSE; end if; end dummy; end Example; 2019-07-05 Ed Schonberg gcc/ada/ * exp_pakd.adb (Expand_Bit_Packed_Element_Set): Add explicit range checks when the index type of the bit-packed array is an enumeration type with a non-standard representation, From-SVN: r273119 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/exp_pakd.adb | 33 ++++++++++++++++++++++++++++++++- 2 files changed, 38 insertions(+), 1 deletion(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9658895ee27..8daf38b3c88 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-07-05 Ed Schonberg + + * exp_pakd.adb (Expand_Bit_Packed_Element_Set): Add explicit + range checks when the index type of the bit-packed array is an + enumeration type with a non-standard representation, + 2019-07-05 Hristian Kirtchev * sem_res.adb (Is_Control_Flow_Statement): Delay statements diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index a7d2a0d31e7..9a659fa3371 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -1022,7 +1022,9 @@ package body Exp_Pakd is Ass_OK : constant Boolean := Assignment_OK (Lhs); -- Used to preserve assignment OK status when assignment is rewritten - Rhs : Node_Id := Expression (N); + Expr : Node_Id; + + Rhs : Node_Id := Expression (N); -- Initially Rhs is the right hand side value, it will be replaced -- later by an appropriate unchecked conversion for the assignment. @@ -1140,6 +1142,35 @@ package body Exp_Pakd is Analyze_And_Resolve (Rhs, Ctyp); end if; + -- If any of the indices has a nonstandard representation, introduce + -- the proper Rep_To_Pos conversion, which in turn will generate index + -- checks when needed. We do this on a copy of the index expression, + -- rather that rewriting the LHS altogether. + + Expr := First (Expressions (Lhs)); + while Present (Expr) loop + declare + Loc : constant Source_Ptr := Sloc (Expr); + Expr_Typ : constant Entity_Id := Etype (Expr); + Expr_Copy : Node_Id; + + begin + if Is_Enumeration_Type (Expr_Typ) + and then Has_Non_Standard_Rep (Expr_Typ) + then + Expr_Copy := + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Expr_Typ, Loc), + Attribute_Name => Name_Pos, + Expressions => New_List (Relocate_Node (Expr))); + Set_Parent (Expr_Copy, N); + Analyze_And_Resolve (Expr_Copy, Standard_Natural); + end if; + end; + + Next (Expr); + end loop; + -- Case of component size 1,2,4 or any component size for the modular -- case. These are the cases for which we can inline the code. -- 2.30.2