Always report pure rules violation, but as a warning in 93c or -frelaxed-rules

For ticket 57.

4 files changed, 44 insertions, 34 deletions

diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index b5fe537..714a283 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -311,6 +311,17 @@ package body Errorout is
       Put_Line (Msg);
    end Error_Msg_Sem;
 
+   procedure Error_Msg_Sem_Relaxed (Msg : String; Loc : Iir)
+   is
+      use Flags;
+   begin
+      if Flag_Relaxed_Rules or Vhdl_Std = Vhdl_93c then
+         Warning_Msg_Sem (Msg, Loc);
+      else
+         Error_Msg_Sem (Msg, Loc);
+      end if;
+   end Error_Msg_Sem_Relaxed;
+
    -- Disp a message during elaboration.
    procedure Error_Msg_Elab (Msg: String) is
    begin
diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads
index e062599..005d191 100644
--- a/src/vhdl/errorout.ads
+++ b/src/vhdl/errorout.ads
@@ -74,6 +74,9 @@ package Errorout is
    procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node);
    procedure Error_Msg_Sem (Msg: String; Loc: Location_Type);
 
+   --  Like Error_Msg_Sem, but a warning if -frelaxed or --std=93c.
+   procedure Error_Msg_Sem_Relaxed (Msg : String; Loc : Iir);
+
    -- Disp a message during elaboration (or configuration).
    procedure Error_Msg_Elab (Msg: String);
    procedure Error_Msg_Elab (Msg: String; Loc: Iir);
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index c7b26cc..8d79338 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -1894,31 +1894,29 @@ package body Sem_Decls is
 
       --  Note: this check is also performed when a file is referenced.
       --    But a file can be declared without being explicitly referenced.
-      if Flags.Vhdl_Std > Vhdl_93c then
-         declare
-            Parent : Iir;
-            Spec : Iir;
-         begin
-            Parent := Get_Parent (Decl);
-            case Get_Kind (Parent) is
-               when Iir_Kind_Function_Body =>
-                  Spec := Get_Subprogram_Specification (Parent);
-                  if Get_Pure_Flag (Spec) then
-                     Error_Msg_Sem
-                       ("cannot declare a file in a pure function", Decl);
-                  end if;
-               when Iir_Kind_Procedure_Body =>
-                  Spec := Get_Subprogram_Specification (Parent);
-                  Set_Purity_State (Spec, Impure);
-                  Set_Impure_Depth (Parent, Iir_Depth_Impure);
-               when Iir_Kind_Function_Declaration
-                 | Iir_Kind_Procedure_Declaration =>
-                  Error_Kind ("sem_file_declaration", Parent);
-               when others =>
-                  null;
-            end case;
-         end;
-      end if;
+      declare
+         Parent : Iir;
+         Spec : Iir;
+      begin
+         Parent := Get_Parent (Decl);
+         case Get_Kind (Parent) is
+            when Iir_Kind_Function_Body =>
+               Spec := Get_Subprogram_Specification (Parent);
+               if Get_Pure_Flag (Spec) then
+                  Error_Msg_Sem_Relaxed
+                    ("cannot declare a file in a pure function", Decl);
+               end if;
+            when Iir_Kind_Procedure_Body =>
+               Spec := Get_Subprogram_Specification (Parent);
+               Set_Purity_State (Spec, Impure);
+               Set_Impure_Depth (Parent, Iir_Depth_Impure);
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration =>
+               Error_Kind ("sem_file_declaration", Parent);
+            when others =>
+               null;
+         end case;
+      end;
    end Sem_File_Declaration;
 
    procedure Sem_Attribute_Declaration (Decl: Iir_Attribute_Declaration)
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index d7bb8c4..6299826 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -1235,7 +1235,7 @@ package body Sem_Names is
       procedure Error_Pure (Subprg : Iir; Obj : Iir)
       is
       begin
-         Error_Msg_Sem
+         Error_Msg_Sem_Relaxed
            ("reference to " & Disp_Node (Obj) & " violate pure rule for "
             & Disp_Node (Subprg), Loc);
       end Error_Pure;
@@ -1288,14 +1288,12 @@ package body Sem_Names is
             --
             --  A pure function must not contain a reference to an explicitly
             --  declared file.
-            if Flags.Vhdl_Std > Vhdl_93c then
-               if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then
-                  Error_Pure (Subprg, Obj);
-               else
-                  Set_Purity_State (Subprg, Impure);
-                  Set_Impure_Depth (Get_Subprogram_Body (Subprg),
-                                    Iir_Depth_Impure);
-               end if;
+            if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then
+               Error_Pure (Subprg, Obj);
+            else
+               Set_Purity_State (Subprg, Impure);
+               Set_Impure_Depth (Get_Subprogram_Body (Subprg),
+                                 Iir_Depth_Impure);
             end if;
             return;
          when others =>