bug fixes

1 files changed, 74 insertions, 22 deletions

diff --git a/sem.adb b/sem.adb
index 0f4d1dd86..1ce422964 100644
--- a/sem.adb
+++ b/sem.adb
@@ -1691,7 +1691,18 @@ package body Sem is
       end case;
    end Sem_Subprogram_Body;
 
-   procedure Update_And_Check_Pure_Wait (Subprg : Iir)
+   --  Status of Update_And_Check_Pure_Wait.
+   type Update_Pure_Status is
+     (
+      --  The purity is computed and known.
+      Update_Pure_Done,
+      --  A missing body prevents from computing the purity.
+      Update_Pure_Missing,
+      --  Purity is unknown (recursion).
+      Update_Pure_Unknown
+     );
+   function Update_And_Check_Pure_Wait (Subprg : Iir)
+                                       return Update_Pure_Status
    is
       procedure Error_Wait (Caller : Iir; Callee : Iir) is
       begin
@@ -1715,20 +1726,11 @@ package body Sem is
       --  Current purity depth of SUBPRG.
       Depth : Iir_Int32;
       Depth_Callee : Iir_Int32;
-      Has_Unknown : Boolean;
       Has_Pure_Errors : Boolean := False;
       Has_Wait_Errors : Boolean := False;
       Npos : Natural;
+      Res, Res1 : Update_Pure_Status;
    begin
-      --  If the subprogram has no callee list, there is nothing to do.
-      if Callees_List = Null_Iir_List then
-         return;
-      end if;
-
-      --  This subprogram is being considered.
-      --  To avoid infinite loop, suppress its callees list.
-      Set_Callees_List (Subprg, Null_Iir_List);
-
       case Get_Kind (Subprg) is
          when Iir_Kind_Function_Declaration =>
             Kind := K_Function;
@@ -1746,7 +1748,8 @@ package body Sem is
             then
                --  No need to go further.
                Destroy_Iir_List (Callees_List);
-               return;
+               Set_Callees_List (Subprg, Null_Iir_List);
+               return Update_Pure_Done;
             end if;
             Subprg_Bod := Get_Subprogram_Body (Subprg);
             Subprg_Depth := Get_Subprogram_Depth (Subprg);
@@ -1760,9 +1763,26 @@ package body Sem is
             Error_Kind ("update_and_check_pure_wait(1)", Subprg);
       end case;
 
+      --  If the subprogram has no callee list, there is nothing to do.
+      if Callees_List = Null_Iir_List then
+         --  There are two reasons why a callees_list is null:
+         --  * either because SUBPRG does not call any procedure
+         --    in this case, the status are already known and we should have
+         --    returned in the above case.
+         --  * or because of a recursion
+         --    in this case the status are still unknown here.
+         return Update_Pure_Unknown;
+      end if;
+
+      --  By default we don't know the status.
+      Res := Update_Pure_Unknown;
+
+      --  This subprogram is being considered.
+      --  To avoid infinite loop, suppress its callees list.
+      Set_Callees_List (Subprg, Null_Iir_List);
+
       --  First loop: check without recursion.
       --  Second loop: recurse if necessary.
-      Has_Unknown := False;
       for J in 0 .. 1 loop
          Npos := 0;
          for I in Natural loop
@@ -1782,13 +1802,16 @@ package body Sem is
                --  No body yet for the subprogram called.
                --  Nothing can be extracted from it, postpone the checks until
                --  elaboration.
-               Has_Unknown := True;
+               Res := Update_Pure_Missing;
             else
                --  Second loop: recurse if a state is not known.
                if J = 1 and then (Get_Purity_State (Callee) = Unknown
                                   or else Get_Wait_State (Callee) = Unknown)
                then
-                  Update_And_Check_Pure_Wait (Callee);
+                  Res1 := Update_And_Check_Pure_Wait (Callee);
+                  if Res1 = Update_Pure_Missing then
+                     Res := Update_Pure_Missing;
+                  end if;
                end if;
 
                --  Check purity only if the subprogram is not impure.
@@ -1857,6 +1880,7 @@ package body Sem is
                   Set_Wait_State (Subprg, False);
                end if;
             end if;
+            Res := Update_Pure_Done;
             exit;
          else
             Set_Nbr_Elements (Callees_List, Npos);
@@ -1864,8 +1888,35 @@ package body Sem is
       end loop;
 
       Set_Callees_List (Subprg, Callees_List);
+
+      return Res;
    end Update_And_Check_Pure_Wait;
 
+   function Root_Update_And_Check_Pure_Wait (Subprg : Iir) return Boolean
+   is
+      Res : Update_Pure_Status;
+   begin
+      Res := Update_And_Check_Pure_Wait (Subprg);
+      case Res is
+         when Update_Pure_Done =>
+            return True;
+         when Update_Pure_Missing =>
+            return False;
+         when Update_Pure_Unknown =>
+            --  The purity/wait is unknown, but all callee were walked.
+            --  This means there are recursive calls but without violations.
+            if Get_Kind (Subprg) = Iir_Kind_Procedure_Declaration then
+               if Get_Purity_State (Subprg) = Unknown then
+                  Set_Purity_State (Subprg, Maybe_Impure);
+               end if;
+               if Get_Wait_State (Subprg) = Unknown then
+                  Set_Wait_State (Subprg, False);
+               end if;
+            end if;
+            return True;
+      end case;
+   end Root_Update_And_Check_Pure_Wait;
+
    procedure Sem_Analysis_Checks_List (Unit : Iir_Design_Unit;
                                        Emit_Warnings : Boolean)
    is
@@ -1887,10 +1938,13 @@ package body Sem is
          case Get_Kind (El) is
             when Iir_Kind_Function_Declaration =>
                --  FIXME: remove from list if fully tested ?
-               Update_And_Check_Pure_Wait (El);
-               Callees := Get_Callees_List (El);
-               if Callees /= Null_Iir_List then
+               if not Root_Update_And_Check_Pure_Wait (El) then
+                  Keep := True;
                   if Emit_Warnings then
+                     Callees := Get_Callees_List (El);
+                     if Callees = Null_Iir_List then
+                        raise Internal_Error;
+                     end if;
                      Warning_Msg_Sem
                        ("can't assert that all calls in " & Disp_Node (El)
                         & " are pure or have not wait; "
@@ -1903,17 +1957,15 @@ package body Sem is
                        ("(first such call is to " & Disp_Node (Callee) & ")",
                         Callee);
                   end if;
-                  Keep := True;
                end if;
             when Iir_Kind_Sensitized_Process_Statement =>
-               Update_And_Check_Pure_Wait (El);
-               if Get_Callees_List (El) /= Null_Iir_List then
+               if not Root_Update_And_Check_Pure_Wait (El) then
+                  Keep := True;
                   if Emit_Warnings then
                      Warning_Msg_Sem
                        ("can't assert that " & Disp_Node (El)
                         & " has not wait; will be checked at elaboration", El);
                   end if;
-                  Keep := True;
                end if;
             when others =>
                Error_Kind ("sem_analysis_checks_list", El);