Handla index of 'image. Fix ticket20.

6 files changed, 194 insertions, 5 deletions

diff --git a/iirs.adb b/iirs.adb
index b7948d19d..f1640a94b 100644
--- a/iirs.adb
+++ b/iirs.adb
@@ -2544,10 +2544,34 @@ package body Iirs is
            | Iir_Kind_Indexed_Name
            | Iir_Kind_Selected_Name
            | Iir_Kind_Selected_By_All_Name
+           | Iir_Kind_Left_Type_Attribute
+           | Iir_Kind_Right_Type_Attribute
+           | Iir_Kind_High_Type_Attribute
+           | Iir_Kind_Low_Type_Attribute
+           | Iir_Kind_Ascending_Type_Attribute
+           | Iir_Kind_Image_Attribute
+           | Iir_Kind_Value_Attribute
+           | Iir_Kind_Pos_Attribute
+           | Iir_Kind_Val_Attribute
+           | Iir_Kind_Succ_Attribute
+           | Iir_Kind_Pred_Attribute
+           | Iir_Kind_Leftof_Attribute
+           | Iir_Kind_Rightof_Attribute
            | Iir_Kind_Delayed_Attribute
            | Iir_Kind_Stable_Attribute
            | Iir_Kind_Quiet_Attribute
-           | Iir_Kind_Transaction_Attribute =>
+           | Iir_Kind_Transaction_Attribute
+           | Iir_Kind_Simple_Name_Attribute
+           | Iir_Kind_Instance_Name_Attribute
+           | Iir_Kind_Path_Name_Attribute
+           | Iir_Kind_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute =>
             null;
          when others =>
             Failed ("Base_Name", Target);
@@ -6101,6 +6125,19 @@ package body Iirs is
            | Iir_Kind_Implicit_Dereference
            | Iir_Kind_Slice_Name
            | Iir_Kind_Indexed_Name
+           | Iir_Kind_Left_Type_Attribute
+           | Iir_Kind_Right_Type_Attribute
+           | Iir_Kind_High_Type_Attribute
+           | Iir_Kind_Low_Type_Attribute
+           | Iir_Kind_Ascending_Type_Attribute
+           | Iir_Kind_Image_Attribute
+           | Iir_Kind_Value_Attribute
+           | Iir_Kind_Pos_Attribute
+           | Iir_Kind_Val_Attribute
+           | Iir_Kind_Succ_Attribute
+           | Iir_Kind_Pred_Attribute
+           | Iir_Kind_Leftof_Attribute
+           | Iir_Kind_Rightof_Attribute
            | Iir_Kind_Delayed_Attribute
            | Iir_Kind_Stable_Attribute
            | Iir_Kind_Quiet_Attribute
@@ -6111,7 +6148,18 @@ package body Iirs is
            | Iir_Kind_Last_Active_Attribute
            | Iir_Kind_Last_Value_Attribute
            | Iir_Kind_Driving_Attribute
-           | Iir_Kind_Driving_Value_Attribute =>
+           | Iir_Kind_Driving_Value_Attribute
+           | Iir_Kind_Simple_Name_Attribute
+           | Iir_Kind_Instance_Name_Attribute
+           | Iir_Kind_Path_Name_Attribute
+           | Iir_Kind_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute =>
             null;
          when others =>
             Failed ("Name_Staticness", Target);
diff --git a/iirs.ads b/iirs.ads
index 3c2d60ff5..e8f6e497e 100644
--- a/iirs.ads
+++ b/iirs.ads
@@ -2578,7 +2578,11 @@ package Iirs is
    --
    --   Get/Set_Prefix (Field3)
    --
+   --   Get/Set_Base_Name (Field5)
+   --
    --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
 
    -- Iir_Kind_Range_Array_Attribute (Short)
    -- Iir_Kind_Reverse_Range_Array_Attribute (Short)
@@ -2597,7 +2601,11 @@ package Iirs is
    --
    --   Get/Set_Parameter (Field4)
    --
+   --   Get/Set_Base_Name (Field5)
+   --
    --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
 
    -- Iir_Kind_Stable_Attribute (Short)
    -- Iir_Kind_Delayed_Attribute (Short)
@@ -2651,7 +2659,11 @@ package Iirs is
    --
    --   Get/Set_Parameter (Field4)
    --
+   --   Get/Set_Base_Name (Field5)
+   --
    --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
 
    -- Iir_Kind_Image_Attribute (Short)
    -- Iir_Kind_Value_Attribute (Short)
@@ -2662,7 +2674,11 @@ package Iirs is
    --
    --   Get/Set_Parameter (Field4)
    --
+   --   Get/Set_Base_Name (Field5)
+   --
    --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
 
    -- Iir_Kind_Simple_Name_Attribute (Short)
    -- Iir_Kind_Instance_Name_Attribute (Short)
@@ -2675,7 +2691,11 @@ package Iirs is
    -- Only for Iir_Kind_Simple_Name_Attribute:
    --   Get/Set_Simple_Name_Identifier (Field2)
    --
+   --   Get/Set_Base_Name (Field5)
+   --
    --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
 
    -- Iir_Kind_Behavior_Attribute (Short)
    -- Iir_Kind_Structure_Attribute (Short)
diff --git a/sem_names.adb b/sem_names.adb
index 23562cb9d..e7bfe6edf 100644
--- a/sem_names.adb
+++ b/sem_names.adb
@@ -763,6 +763,10 @@ package body Sem_Names is
             raise Internal_Error;
       end case;
 
+      if Get_Parameter (Attr) /= Null_Iir then
+         raise Internal_Error;
+      end if;
+
       Set_Parameter (Attr, Parameter);
       if Get_Kind (Prefix_Type) = Iir_Kind_Array_Subtype_Definition then
          Set_Index_Subtype (Attr, Index_Type);
@@ -852,6 +856,9 @@ package body Sem_Names is
          when others =>
             raise Internal_Error;
       end case;
+      if Get_Parameter (Attr) /= Null_Iir then
+         raise Internal_Error;
+      end if;
       if Parameter = Null_Iir then
          Set_Parameter (Attr, Param);
          Set_Expr_Staticness (Attr, None);
@@ -860,6 +867,7 @@ package body Sem_Names is
       Set_Parameter (Attr, Parameter);
       Set_Expr_Staticness (Attr, Min (Get_Type_Staticness (Prefix_Type),
                                       Get_Expr_Staticness (Parameter)));
+      Set_Name_Staticness (Attr, Get_Expr_Staticness (Attr));
    end Finish_Sem_Scalar_Type_Attribute;
 
    procedure Finish_Sem_Signal_Attribute (Attr : Iir; Parameter : Iir)
@@ -1069,6 +1077,8 @@ package body Sem_Names is
                   Finish_Sem_Name (Name_Pfx, Pfx);
                end if;
             end if;
+         when Iir_Kinds_Attribute =>
+            null;
          when others =>
             Error_Kind ("finish_sem_implicits", Pfx);
       end case;
@@ -2043,14 +2053,20 @@ package body Sem_Names is
             when Iir_Kinds_Scalar_Type_Attribute
               | Iir_Kind_Image_Attribute
               | Iir_Kind_Value_Attribute =>
-               if Actual /= Null_Iir then
+               if Get_Parameter (Prefix) /= Null_Iir then
+                  --  Attribute already has a parameter, the expression
+                  --  is either a slice or an index.
+                  Add_Result
+                    (Res, Sem_As_Indexed_Or_Slice_Name (Prefix, True));
+               elsif Actual /= Null_Iir then
                   Finish_Sem_Scalar_Type_Attribute (Prefix, Actual);
                   Set_Named_Entity (Name, Prefix);
+                  return;
                else
                   Error_Msg_Sem ("bad attribute parameter", Name);
                   Set_Named_Entity (Name, Error_Mark);
+                  return;
                end if;
-               return;
 
             when Iir_Kind_Type_Declaration
               | Iir_Kind_Subtype_Declaration =>
@@ -2361,6 +2377,7 @@ package body Sem_Names is
       end case;
       Location_Copy (Res, Attr);
       Set_Prefix (Res, Prefix);
+      Set_Base_Name (Res, Res);
 
       case Get_Attribute_Identifier (Attr) is
          when Name_Pos =>
@@ -2427,6 +2444,8 @@ package body Sem_Names is
       Location_Copy (Res, Attr);
       Prefix := Get_Named_Entity (Get_Prefix (Attr));
       Set_Prefix (Res, Prefix);
+      Set_Base_Name (Res, Res);
+
       Prefix_Type := Get_Type (Prefix);
       case Get_Attribute_Identifier (Attr) is
          when Name_Ascending =>
@@ -3366,7 +3385,7 @@ package body Sem_Names is
            | Iir_Kind_Dereference
            | Iir_Kind_Attribute_Value
            | Iir_Kind_Function_Call
-           | Iir_Kinds_Signal_Attribute =>
+           | Iir_Kinds_Attribute =>
             return True;
          when Iir_Kind_Simple_Name
            | Iir_Kind_Selected_Name =>
diff --git a/sem_stmts.ads b/sem_stmts.ads
index 59102affe..d3eeb8c09 100644
--- a/sem_stmts.ads
+++ b/sem_stmts.ads
@@ -56,6 +56,9 @@ package Sem_Stmts is
    --  This is used by processes and subprograms semantization.
    procedure Sem_Sequential_Statements (Decl : Iir; Body_Parent : Iir);
 
+   --  Sem for concurrent and sequential assertion statements.
+   procedure Sem_Report_Statement (Stmt : Iir);
+
    -- Get the current subprogram or process.
    function Get_Current_Subprogram return Iir;
    pragma Inline (Get_Current_Subprogram);
diff --git a/testsuite/gna/ticket20/morten1.vhdl b/testsuite/gna/ticket20/morten1.vhdl
new file mode 100644
index 000000000..3881f653a
--- /dev/null
+++ b/testsuite/gna/ticket20/morten1.vhdl
@@ -0,0 +1,91 @@
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+-- library std;
+use std.textio.all;
+
+entity morten is
+end entity;
+
+architecture foo of morten is
+    
+    signal clk: std_logic := '0';
+    signal rst: std_logic := '1';
+    signal cnt_1: unsigned (7 downto 0);
+    signal cnt_3: unsigned (7 downto 0);
+    
+    function to_bstring(sl : std_logic) return string is
+    begin
+      return "" & std_logic'image(sl)(2);  -- "" & character to get string
+    end function;
+
+    function to_bstring(slv : std_logic_vector) return string is
+      alias slv_norm : std_logic_vector(1 to slv'length) is slv;
+    begin
+      if slv_norm'length = 0 then
+        return "";
+      elsif slv_norm'length = 1 then
+        return to_bstring(slv_norm(1));
+      else  -- slv_norm'length > 0
+        return to_bstring(slv_norm(1)) & to_bstring(slv_norm(2 to slv_norm'length));
+      end if;
+    end function;
+    
+begin
+
+
+PRINT:        
+    process (clk) is
+        variable line_v   : line;
+        file     out_file : text open write_mode is "out.txt";
+    begin
+        if rising_edge(clk) then
+            write(line_v, to_bstring(rst) & " " & 
+                          to_bstring(std_logic_vector(cnt_1)) & " " & 
+                          to_bstring(std_logic_vector(cnt_3))
+                 );
+            writeline(out_file, line_v);
+      end if;
+    end process;
+    
+COUNTER1:
+    process (clk,rst)
+    begin
+        if rst = '1' then
+            cnt_1 <= (others => '0');
+        elsif rising_edge(clk) then
+            cnt_1 <= cnt_1 + 1;
+        end if;
+    end process;
+
+COUNTER3: 
+    process (clk,rst)
+    begin
+        if rst = '1' then
+            cnt_3 <= (others => '0');
+        elsif rising_edge(clk) then
+            cnt_3 <= cnt_3 + 3;
+        end if;
+    end process;
+
+RESET:
+    process
+    begin
+        wait until rising_edge(clk);
+        wait until rising_edge(clk);
+        wait until rising_edge(clk);
+        rst <= '0';
+        wait;
+    end process;
+
+CLOCK:
+    process 
+    begin
+        wait for 10 ns;
+        clk <= not clk;
+        if Now > 210 ns then
+            wait;
+        end if;
+    end process;
+
+end architecture;
\ No newline at end of file
diff --git a/testsuite/gna/ticket20/testsuite.sh b/testsuite/gna/ticket20/testsuite.sh
new file mode 100755
index 000000000..79085ee17
--- /dev/null
+++ b/testsuite/gna/ticket20/testsuite.sh
@@ -0,0 +1,8 @@
+#!/bin/sh
+
+. ../../testenv.sh
+
+analyze morten1.vhdl
+elab_simulate morten
+
+clean
\ No newline at end of file