diff options
| -rw-r--r-- | src/options.adb | 2 | ||||
| -rw-r--r-- | src/vhdl/errorout.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/sem_expr.adb | 34 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap7.adb | 19 |
4 files changed, 36 insertions, 22 deletions
diff --git a/src/options.adb b/src/options.adb index 43f68bbb5..f200d1c71 100644 --- a/src/options.adb +++ b/src/options.adb @@ -112,7 +112,7 @@ package body Options is elsif Opt'Length > 7 and then Opt (1 .. 7) = "--warn-" then return Option_Warning (Opt (8 .. Opt'Last), True); elsif Opt'Length > 5 and then Opt (1 .. 5) = "-Wno-" then - -- Handle -Wno before -W! + -- Handle -Wno-xxx before -Wxxx return Option_Warning (Opt (6 .. Opt'Last), False); elsif Opt'Length > 2 and then Opt (1 .. 2) = "-W" then return Option_Warning (Opt (3 .. Opt'Last), True); diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads index f512b0624..595c5c094 100644 --- a/src/vhdl/errorout.ads +++ b/src/vhdl/errorout.ads @@ -110,6 +110,9 @@ package Errorout is -- FIXME: currently only subprograms are handled. Warnid_Unused, + -- Others choice is not needed, all values are already covered. + Warnid_Others, + -- Violation of pure rules. Warnid_Pure, diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb index 605530067..11b4e544c 100644 --- a/src/vhdl/sem_expr.adb +++ b/src/vhdl/sem_expr.adb @@ -2519,8 +2519,7 @@ package body Sem_Expr is -- of index type BT at location LOC. procedure Error_No_Choice (Bt : Iir; L, H : Iir_Int64; - Loc : Location_Type) - is + Loc : Location_Type) is begin if L = H then Error_Msg_Sem (+Loc, "no choice for " & Disp_Discrete (Bt, L)); @@ -2536,6 +2535,8 @@ package body Sem_Expr is Pos : Iir_Int64; Pos_Max : Iir_Int64; E_Pos : Iir_Int64; + Choice : Iir; + Need_Others : Boolean; Bt : constant Iir := Get_Base_Type (Choice_Type); begin @@ -2561,40 +2562,53 @@ package body Sem_Expr is Free (Info.Arr); return; end if; + Need_Others := False; for I in Info.Arr'Range loop - E_Pos := Eval_Pos (Get_Assoc_Low (Info.Arr (I))); + Choice := Info.Arr (I); + E_Pos := Eval_Pos (Get_Assoc_Low (Choice)); if E_Pos > Pos_Max then -- Choice out of bound, already handled. - Error_No_Choice - (Bt, Pos, Pos_Max, Get_Location (Info.Arr (I))); + Error_No_Choice (Bt, Pos, Pos_Max, Get_Location (Choice)); -- Avoid other errors. Pos := Pos_Max + 1; exit; end if; if Pos < E_Pos then + Need_Others := True; if Info.Others_Choice = Null_Iir then - Error_No_Choice - (Bt, Pos, E_Pos - 1, Get_Location (Info.Arr (I))); + Error_No_Choice (Bt, Pos, E_Pos - 1, Get_Location (Choice)); end if; elsif Pos > E_Pos then + Need_Others := True; if Pos = E_Pos + 1 then Error_Msg_Sem - (+Info.Arr (I), + (+Choice, "duplicate choice for " & Disp_Discrete (Bt, E_Pos)); else Error_Msg_Sem - (+Info.Arr (I), "duplicate choices for " + (+Choice, "duplicate choices for " & Disp_Discrete (Bt, E_Pos) & " to " & Disp_Discrete (Bt, Pos)); end if; end if; - Pos := Eval_Pos (Get_Assoc_High (Info.Arr (I))) + 1; + + if Get_Kind (Choice) = Iir_Kind_Choice_By_Range then + Pos := Eval_Pos (Get_Assoc_High (Choice)) + 1; + else + Pos := E_Pos + 1; + end if; end loop; if Pos /= Pos_Max + 1 then + Need_Others := True; if Info.Others_Choice = Null_Iir then Error_No_Choice (Bt, Pos, Pos_Max, Loc); end if; end if; + + if not Need_Others and then Info.Others_Choice /= Null_Iir then + Warning_Msg_Sem (Warnid_Others, +Info.Others_Choice, + "redundant 'others' choices"); + end if; end; -- LRM93 7.3.2.2 Array aggregates diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index 582b3be68..67ef4bed3 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -2931,7 +2931,9 @@ package body Trans.Chap7 is -- Assign EXPR to current position (defined by index VAR_INDEX), and -- update VAR_INDEX. Handles sub-aggregates. - procedure Do_Assign (Expr : Iir) is + procedure Do_Assign (Assoc : Iir) + is + Expr : constant Iir := Get_Associated_Expr (Assoc); begin if Final then Translate_Assign (Chap3.Index_Base (Base_Ptr, Aggr_Type, @@ -2960,7 +2962,7 @@ package body Trans.Chap7 is return; end if; exit when Get_Kind (El) /= Iir_Kind_Choice_By_None; - Do_Assign (Get_Associated_Expr (El)); + Do_Assign (El); P := P + 1; El := Get_Chain (El); end loop; @@ -2997,7 +2999,7 @@ package body Trans.Chap7 is New_Lit (Ghdl_Index_0), Ghdl_Bool_Type)); - Do_Assign (Get_Associated_Expr (El)); + Do_Assign (El); Dec_Var (Var_Len); Finish_Loop_Stmt (Label); Close_Temp; @@ -3018,7 +3020,7 @@ package body Trans.Chap7 is -- Handled by positional. raise Internal_Error; when Iir_Kind_Choice_By_Expression => - Do_Assign (Get_Associated_Expr (El)); + Do_Assign (El); return; when Iir_Kind_Choice_By_Range => declare @@ -3038,7 +3040,7 @@ package body Trans.Chap7 is New_Obj_Value (Var_I), New_Obj_Value (Var_Length), Ghdl_Bool_Type)); - Do_Assign (Get_Associated_Expr (El)); + Do_Assign (El); Inc_Var (Var_I); Finish_Loop_Stmt (Label); Close_Temp; @@ -3059,7 +3061,6 @@ package body Trans.Chap7 is If_Blk : O_If_Block; Case_Blk : O_Case_Block; Label : O_Snode; - El_Assoc : Iir; Len_Tmp : O_Enode; begin Open_Temp; @@ -3089,15 +3090,11 @@ package body Trans.Chap7 is -- convert aggr into a case statement. Start_Case_Stmt (Case_Blk, New_Obj_Value (Var_Pos)); - El_Assoc := Null_Iir; while El /= Null_Iir loop Start_Choice (Case_Blk); Chap8.Translate_Case_Choice (El, Range_Type, Case_Blk); - if Get_Associated_Expr (El) /= Null_Iir then - El_Assoc := Get_Associated_Expr (El); - end if; Finish_Choice (Case_Blk); - Do_Assign (El_Assoc); + Do_Assign (El); El := Get_Chain (El); end loop; Finish_Case_Stmt (Case_Blk); |