Fix crash on invalid individual association.

1 files changed, 248 insertions, 217 deletions

diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index ec796b974..295601938 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -2310,17 +2310,19 @@ package body Sem_Expr is
       end if;
    end Sem_String_Choices_Range;
 
-   procedure Sem_Choices_Range
-     (Choice_Chain : in out Iir;
+   procedure Sem_Check_Continuous_Choices
+     (Choice_Chain : Iir;
       Sub_Type : Iir;
       Is_Sub_Range : Boolean;
-      Is_Case_Stmt : Boolean;
       Loc : Location_Type;
       Low : out Iir;
       High : out Iir)
    is
-      --  Number of positionnal choice.
-      Nbr_Pos : Iir_Int64;
+      --  Nodes that can appear.
+      subtype Iir_Kinds_Case_Choice is Iir_Kind range
+        Iir_Kind_Choice_By_Others ..
+        --Iir_Kind_Choice_By_Expression
+        Iir_Kind_Choice_By_Range;
 
       --  Number of named choices.
       Nbr_Named : Natural;
@@ -2328,113 +2330,12 @@ package body Sem_Expr is
       --  True if others choice is present.
       Has_Others : Boolean;
 
-      Has_Error : Boolean;
-
       --  True if SUB_TYPE has bounds.
       Type_Has_Bounds : Boolean;
 
       Arr : Iir_Array_Acc;
       Index : Natural;
-      Pos_Max : Iir_Int64;
       El : Iir;
-      Prev_El : Iir;
-
-      --  Staticness of the current choice.
-      Choice_Staticness : Iir_Staticness;
-
-      --  Staticness of all the choices.
-      Staticness : Iir_Staticness;
-
-      function Replace_By_Range_Choice (Name : Iir; Range_Type : Iir)
-                                       return Boolean
-      is
-         N_Choice : Iir;
-         Name1 : Iir;
-      begin
-         if Are_Types_Compatible (Range_Type, Sub_Type) = Not_Compatible then
-            Not_Match (Name, Sub_Type);
-            return False;
-         end if;
-
-         Name1 := Finish_Sem_Name (Name);
-         N_Choice := Create_Iir (Iir_Kind_Choice_By_Range);
-         Location_Copy (N_Choice, El);
-         Set_Chain (N_Choice, Get_Chain (El));
-         Set_Associated_Expr (N_Choice, Get_Associated_Expr (El));
-         Set_Associated_Chain (N_Choice, Get_Associated_Chain (El));
-         Set_Same_Alternative_Flag (N_Choice, Get_Same_Alternative_Flag (El));
-         Set_Choice_Range (N_Choice, Eval_Range_If_Static (Name1));
-         Set_Choice_Staticness (N_Choice, Get_Type_Staticness (Range_Type));
-         Free_Iir (El);
-
-         if Prev_El = Null_Iir then
-            Choice_Chain := N_Choice;
-         else
-            Set_Chain (Prev_El, N_Choice);
-         end if;
-         El := N_Choice;
-
-         return True;
-      end Replace_By_Range_Choice;
-
-      --  Analyze a simple (by expression or by range) choice.
-      --  Return FALSE in case of error.
-      function Sem_Simple_Choice return Boolean
-      is
-         Expr : Iir;
-         Ent : Iir;
-      begin
-         if Get_Kind (El) = Iir_Kind_Choice_By_Range then
-            Expr := Get_Choice_Range (El);
-            Expr := Sem_Discrete_Range_Expression (Expr, Sub_Type, True);
-            if Expr = Null_Iir then
-               return False;
-            end if;
-            Expr := Eval_Range_If_Static (Expr);
-            Set_Choice_Range (El, Expr);
-         else
-            Expr := Get_Choice_Expression (El);
-            case Get_Kind (Expr) is
-               when Iir_Kind_Selected_Name
-                 | Iir_Kind_Simple_Name
-                 | Iir_Kind_Character_Literal
-                 | Iir_Kind_Parenthesis_Name
-                 | Iir_Kind_Selected_By_All_Name
-                 | Iir_Kind_Attribute_Name =>
-                  Sem_Name (Expr);
-                  Ent := Get_Named_Entity (Expr);
-                  if Ent = Error_Mark then
-                     return False;
-                  end if;
-
-                  --  So range or expression ?
-                  --  FIXME: share code with sem_name for slice/index.
-                  case Get_Kind (Ent) is
-                     when Iir_Kind_Range_Array_Attribute
-                       | Iir_Kind_Reverse_Range_Array_Attribute
-                       | Iir_Kind_Range_Expression =>
-                        return Replace_By_Range_Choice (Expr, Ent);
-                     when Iir_Kind_Subtype_Declaration
-                       | Iir_Kind_Type_Declaration =>
-                        Ent := Is_Type_Name (Expr);
-                        Set_Expr_Staticness (Expr, Get_Type_Staticness (Ent));
-                        return Replace_By_Range_Choice (Expr, Ent);
-                     when others =>
-                        Expr := Name_To_Expression
-                          (Expr, Get_Base_Type (Sub_Type));
-                  end case;
-               when others =>
-                  Expr := Sem_Expression_Ov (Expr, Get_Base_Type (Sub_Type));
-            end case;
-            if Expr = Null_Iir then
-               return False;
-            end if;
-            Expr := Eval_Expr_If_Static (Expr);
-            Set_Choice_Expression (El, Expr);
-         end if;
-         Set_Choice_Staticness (El, Get_Expr_Staticness (Expr));
-         return True;
-      end Sem_Simple_Choice;
 
       --  Get low limit of ASSOC.
       --  First, get the expression of the association, then the low limit.
@@ -2452,12 +2353,7 @@ package body Sem_Expr is
                Expr := Get_Choice_Range (Assoc);
                case Get_Kind (Expr) is
                   when Iir_Kind_Range_Expression =>
-                     case Get_Direction (Expr) is
-                        when Iir_To =>
-                           return Get_Left_Limit (Expr);
-                        when Iir_Downto =>
-                           return Get_Right_Limit (Expr);
-                     end case;
+                     return Get_Low_Limit (Expr);
                   when others =>
                      return Expr;
                end case;
@@ -2477,12 +2373,7 @@ package body Sem_Expr is
                Expr := Get_Choice_Range (Assoc);
                case Get_Kind (Expr) is
                   when Iir_Kind_Range_Expression =>
-                     case Get_Direction (Expr) is
-                        when Iir_To =>
-                           return Get_Right_Limit (Expr);
-                        when Iir_Downto =>
-                           return Get_Left_Limit (Expr);
-                     end case;
+                     return Get_High_Limit (Expr);
                   when others =>
                      return Expr;
                end case;
@@ -2514,112 +2405,23 @@ package body Sem_Expr is
       Low := Null_Iir;
       High := Null_Iir;
 
-      --  First:
-      --  Analyze the choices
-      --  compute the range of positionnal choices
-      --  compute the number of choice elements (extracted from lists).
-      --  check for others presence.
-      Nbr_Pos := 0;
+      --  Compute the number of elements, return early if a choice is not
+      --  static.
       Nbr_Named := 0;
       Has_Others := False;
-      Has_Error := False;
-      Staticness := Locally;
       El := Choice_Chain;
-      Prev_El := Null_Iir;
       while El /= Null_Iir loop
-         case Get_Kind (El) is
-            when Iir_Kind_Choice_By_None =>
-               Nbr_Pos := Nbr_Pos + 1;
+         case Iir_Kinds_Case_Choice (Get_Kind (El)) is
             when Iir_Kind_Choice_By_Expression
               | Iir_Kind_Choice_By_Range =>
-               if Sem_Simple_Choice then
-                  Choice_Staticness := Get_Choice_Staticness (El);
-                  Staticness := Min (Staticness, Choice_Staticness);
-                  if Choice_Staticness /= Locally
-                    and then Is_Case_Stmt
-                  then
-                     --  FIXME: explain why
-                     Error_Msg_Sem ("choice is not locally static", El);
-                  end if;
-               else
-                  Has_Error := True;
-               end if;
+               pragma Assert (Get_Choice_Staticness (El) = Locally);
                Nbr_Named := Nbr_Named + 1;
-            when Iir_Kind_Choice_By_Name =>
-               --  It is not possible to have such a choice in an array
-               --  aggregate.
-               --  Should have been caught previously.
-               raise Internal_Error;
             when Iir_Kind_Choice_By_Others =>
-               if Has_Others then
-                  Error_Msg_Sem ("duplicate others choice", El);
-               elsif Get_Chain (El) /= Null_Iir then
-                  Error_Msg_Sem
-                    ("choice others should be the last alternative", El);
-               end if;
                Has_Others := True;
-            when others =>
-               Error_Kind ("sem_choices_range", El);
          end case;
-         Prev_El := El;
          El := Get_Chain (El);
       end loop;
 
-      if Has_Error then
-         --  Nothing can be done here...
-         return;
-      end if;
-      if Nbr_Pos > 0 and then Nbr_Named > 0 then
-         --  LRM93 7.3.2.2
-         --  Apart from the final element with the single choice OTHERS, the
-         --  rest (if any) of the element associations of an array aggregate
-         --  must be either all positionnal or all named.
-         Error_Msg_Sem
-           ("element associations must be all positional or all named", Loc);
-         return;
-      end if;
-
-      --  For a positional aggregate.
-      if Nbr_Pos > 0 then
-         --  Check number of elements match, but only if it is possible.
-         if Get_Type_Staticness (Sub_Type) /= Locally then
-            return;
-         end if;
-         Pos_Max := Eval_Discrete_Type_Length (Sub_Type);
-         if (not Has_Others and not Is_Sub_Range)
-           and then Nbr_Pos < Pos_Max
-         then
-            Error_Msg_Sem ("not enough elements associated", Loc);
-         elsif Nbr_Pos > Pos_Max then
-            Error_Msg_Sem ("too many elements associated", Loc);
-         end if;
-         return;
-      end if;
-
-      --  Second:
-      --  Create the list of choices
-      if Nbr_Named = 0 and then Has_Others then
-         --  This is only a others association.
-         return;
-      end if;
-      if Staticness /= Locally then
-         --  Emit a message for aggregrate.  The message has already been
-         --  emitted for a case stmt.
-         --  FIXME: what about individual associations?
-         if not Is_Case_Stmt then
-            --  LRM93 §7.3.2.2
-            --  A named association of an array aggregate is allowed to have
-            --  a choice that is not locally static, or likewise a choice that
-            --  is a null range, only if the aggregate includes a single
-            --  element association and the element association has a single
-            --  choice.
-            if Nbr_Named > 1 or Has_Others then
-               Error_Msg_Sem ("not static choice exclude others choice", Loc);
-            end if;
-         end if;
-         return;
-      end if;
-
       --  Set TYPE_HAS_BOUNDS
       case Get_Kind (Sub_Type) is
          when Iir_Kind_Enumeration_Type_Definition
@@ -2670,17 +2472,12 @@ package body Sem_Expr is
          --  Fill the array.
          El := Choice_Chain;
          while El /= Null_Iir loop
-            case Get_Kind (El) is
-               when Iir_Kind_Choice_By_None =>
-                  --  Only named associations are considered.
-                  raise Internal_Error;
+            case Iir_Kinds_Case_Choice (Get_Kind (El)) is
                when Iir_Kind_Choice_By_Expression
                  | Iir_Kind_Choice_By_Range =>
                   Add_Choice (El, Sub_Type);
                when Iir_Kind_Choice_By_Others =>
                   null;
-               when others =>
-                  Error_Kind ("sem_choices_range(2)", El);
             end case;
             El := Get_Chain (El);
          end loop;
@@ -2779,6 +2576,240 @@ package body Sem_Expr is
       end;
 
       Free (Arr);
+   end Sem_Check_Continuous_Choices;
+
+   procedure Sem_Choices_Range
+     (Choice_Chain : in out Iir;
+      Sub_Type : Iir;
+      Is_Sub_Range : Boolean;
+      Is_Case_Stmt : Boolean;
+      Loc : Location_Type;
+      Low : out Iir;
+      High : out Iir)
+   is
+      --  Number of positionnal choice.
+      Nbr_Pos : Iir_Int64;
+
+      --  Number of named choices.
+      Nbr_Named : Natural;
+
+      --  True if others choice is present.
+      Has_Others : Boolean;
+
+      Has_Error : Boolean;
+
+      Pos_Max : Iir_Int64;
+      El : Iir;
+      Prev_El : Iir;
+
+      --  Staticness of the current choice.
+      Choice_Staticness : Iir_Staticness;
+
+      --  Staticness of all the choices.
+      Staticness : Iir_Staticness;
+
+      function Replace_By_Range_Choice (Name : Iir; Range_Type : Iir)
+                                       return Boolean
+      is
+         N_Choice : Iir;
+         Name1 : Iir;
+      begin
+         if Are_Types_Compatible (Range_Type, Sub_Type) = Not_Compatible then
+            Not_Match (Name, Sub_Type);
+            return False;
+         end if;
+
+         Name1 := Finish_Sem_Name (Name);
+         N_Choice := Create_Iir (Iir_Kind_Choice_By_Range);
+         Location_Copy (N_Choice, El);
+         Set_Chain (N_Choice, Get_Chain (El));
+         Set_Associated_Expr (N_Choice, Get_Associated_Expr (El));
+         Set_Associated_Chain (N_Choice, Get_Associated_Chain (El));
+         Set_Same_Alternative_Flag (N_Choice, Get_Same_Alternative_Flag (El));
+         Set_Choice_Range (N_Choice, Eval_Range_If_Static (Name1));
+         Set_Choice_Staticness (N_Choice, Get_Type_Staticness (Range_Type));
+         Free_Iir (El);
+
+         if Prev_El = Null_Iir then
+            Choice_Chain := N_Choice;
+         else
+            Set_Chain (Prev_El, N_Choice);
+         end if;
+         El := N_Choice;
+
+         return True;
+      end Replace_By_Range_Choice;
+
+      --  Analyze a simple (by expression or by range) choice.
+      --  Return FALSE in case of error.
+      function Sem_Simple_Choice return Boolean
+      is
+         Expr : Iir;
+         Ent : Iir;
+      begin
+         if Get_Kind (El) = Iir_Kind_Choice_By_Range then
+            Expr := Get_Choice_Range (El);
+            Expr := Sem_Discrete_Range_Expression (Expr, Sub_Type, True);
+            if Expr = Null_Iir then
+               return False;
+            end if;
+            Expr := Eval_Range_If_Static (Expr);
+            Set_Choice_Range (El, Expr);
+         else
+            Expr := Get_Choice_Expression (El);
+            case Get_Kind (Expr) is
+               when Iir_Kind_Selected_Name
+                 | Iir_Kind_Simple_Name
+                 | Iir_Kind_Character_Literal
+                 | Iir_Kind_Parenthesis_Name
+                 | Iir_Kind_Selected_By_All_Name
+                 | Iir_Kind_Attribute_Name =>
+                  Sem_Name (Expr);
+                  Ent := Get_Named_Entity (Expr);
+                  if Ent = Error_Mark then
+                     return False;
+                  end if;
+
+                  --  So range or expression ?
+                  --  FIXME: share code with sem_name for slice/index.
+                  case Get_Kind (Ent) is
+                     when Iir_Kind_Range_Array_Attribute
+                       | Iir_Kind_Reverse_Range_Array_Attribute
+                       | Iir_Kind_Range_Expression =>
+                        return Replace_By_Range_Choice (Expr, Ent);
+                     when Iir_Kind_Subtype_Declaration
+                       | Iir_Kind_Type_Declaration =>
+                        Ent := Is_Type_Name (Expr);
+                        Set_Expr_Staticness (Expr, Get_Type_Staticness (Ent));
+                        return Replace_By_Range_Choice (Expr, Ent);
+                     when others =>
+                        Expr := Name_To_Expression
+                          (Expr, Get_Base_Type (Sub_Type));
+                  end case;
+               when others =>
+                  Expr := Sem_Expression_Ov (Expr, Get_Base_Type (Sub_Type));
+            end case;
+            if Expr = Null_Iir then
+               return False;
+            end if;
+            Expr := Eval_Expr_If_Static (Expr);
+            Set_Choice_Expression (El, Expr);
+         end if;
+         Set_Choice_Staticness (El, Get_Expr_Staticness (Expr));
+         return True;
+      end Sem_Simple_Choice;
+   begin
+      Low := Null_Iir;
+      High := Null_Iir;
+
+      --  First:
+      --  Analyze the choices
+      --  compute the range of positionnal choices
+      --  compute the number of choice elements (extracted from lists).
+      --  check for others presence.
+      Nbr_Pos := 0;
+      Nbr_Named := 0;
+      Has_Others := False;
+      Has_Error := False;
+      Staticness := Locally;
+      El := Choice_Chain;
+      Prev_El := Null_Iir;
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Choice_By_None =>
+               Nbr_Pos := Nbr_Pos + 1;
+            when Iir_Kind_Choice_By_Expression
+              | Iir_Kind_Choice_By_Range =>
+               if Sem_Simple_Choice then
+                  Choice_Staticness := Get_Choice_Staticness (El);
+                  Staticness := Min (Staticness, Choice_Staticness);
+                  if Choice_Staticness /= Locally
+                    and then Is_Case_Stmt
+                  then
+                     --  FIXME: explain why
+                     Error_Msg_Sem ("choice is not locally static", El);
+                  end if;
+               else
+                  Has_Error := True;
+               end if;
+               Nbr_Named := Nbr_Named + 1;
+            when Iir_Kind_Choice_By_Name =>
+               --  It is not possible to have such a choice in an array
+               --  aggregate.
+               --  Should have been caught previously.
+               raise Internal_Error;
+            when Iir_Kind_Choice_By_Others =>
+               if Has_Others then
+                  Error_Msg_Sem ("duplicate others choice", El);
+               elsif Get_Chain (El) /= Null_Iir then
+                  Error_Msg_Sem
+                    ("choice others should be the last alternative", El);
+               end if;
+               Has_Others := True;
+            when others =>
+               Error_Kind ("sem_choices_range", El);
+         end case;
+         Prev_El := El;
+         El := Get_Chain (El);
+      end loop;
+
+      if Has_Error then
+         --  Nothing can be done here...
+         return;
+      end if;
+      if Nbr_Pos > 0 and then Nbr_Named > 0 then
+         --  LRM93 7.3.2.2
+         --  Apart from the final element with the single choice OTHERS, the
+         --  rest (if any) of the element associations of an array aggregate
+         --  must be either all positionnal or all named.
+         Error_Msg_Sem
+           ("element associations must be all positional or all named", Loc);
+         return;
+      end if;
+
+      --  For a positional aggregate.
+      if Nbr_Pos > 0 then
+         --  Check number of elements match, but only if it is possible.
+         if Get_Type_Staticness (Sub_Type) /= Locally then
+            return;
+         end if;
+         Pos_Max := Eval_Discrete_Type_Length (Sub_Type);
+         if (not Has_Others and not Is_Sub_Range)
+           and then Nbr_Pos < Pos_Max
+         then
+            Error_Msg_Sem ("not enough elements associated", Loc);
+         elsif Nbr_Pos > Pos_Max then
+            Error_Msg_Sem ("too many elements associated", Loc);
+         end if;
+         return;
+      end if;
+
+      --  Second:
+      --  Create the list of choices
+      if Nbr_Named = 0 and then Has_Others then
+         --  This is only a others association.
+         return;
+      end if;
+      if Staticness /= Locally then
+         --  Emit a message for aggregrate.  The message has already been
+         --  emitted for a case stmt.
+         --  FIXME: what about individual associations?
+         if not Is_Case_Stmt then
+            --  LRM93 §7.3.2.2
+            --  A named association of an array aggregate is allowed to have
+            --  a choice that is not locally static, or likewise a choice that
+            --  is a null range, only if the aggregate includes a single
+            --  element association and the element association has a single
+            --  choice.
+            if Nbr_Named > 1 or Has_Others then
+               Error_Msg_Sem ("not static choice exclude others choice", Loc);
+            end if;
+         end if;
+         return;
+      end if;
+
+      Sem_Check_Continuous_Choices
+        (Choice_Chain, Sub_Type, Is_Sub_Range, Loc, Low, High);
    end Sem_Choices_Range;
 
 --    -- Find out the MIN and the MAX of an all named association choice list.