diff options
Diffstat (limited to 'src/vhdl')
| -rw-r--r-- | src/vhdl/errorout.adb | 11 | ||||
| -rw-r--r-- | src/vhdl/errorout.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/sem_decls.adb | 48 | ||||
| -rw-r--r-- | src/vhdl/sem_names.adb | 16 |
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 => |