aboutsummaryrefslogtreecommitdiffstats
path: root/src/vhdl
diff options
context:
space:
mode:
Diffstat (limited to 'src/vhdl')
-rw-r--r--src/vhdl/configuration.adb21
-rw-r--r--src/vhdl/errorout.adb107
-rw-r--r--src/vhdl/errorout.ads89
-rw-r--r--src/vhdl/evaluation.adb36
-rw-r--r--src/vhdl/ieee-vital_timing.adb9
-rw-r--r--src/vhdl/parse.adb3
-rw-r--r--src/vhdl/scanner.adb26
-rw-r--r--src/vhdl/sem.adb11
-rw-r--r--src/vhdl/sem_decls.adb5
-rw-r--r--src/vhdl/sem_expr.adb6
-rw-r--r--src/vhdl/sem_names.adb3
-rw-r--r--src/vhdl/sem_specs.adb32
-rw-r--r--src/vhdl/sem_stmts.adb11
-rw-r--r--src/vhdl/simulate/elaboration.adb3
-rw-r--r--src/vhdl/translate/ortho_front.adb2
-rw-r--r--src/vhdl/translate/trans-chap7.adb3
16 files changed, 263 insertions, 104 deletions
diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb
index c4bc0434f..671514e46 100644
--- a/src/vhdl/configuration.adb
+++ b/src/vhdl/configuration.adb
@@ -67,10 +67,11 @@ package body Configuration is
-- May be enabled to debug dependency construction.
if False then
if From = Null_Iir then
- Warning_Msg_Elab (Disp_Node (Unit) & " added", Unit);
+ Report_Msg (Msgid_Note, Elaboration, Get_Location (Unit),
+ Disp_Node (Unit) & " added");
else
- Warning_Msg_Elab
- (Disp_Node (Unit) & " added by " & Disp_Node (From), From);
+ Report_Msg (Msgid_Note, Elaboration, Get_Location (From),
+ Disp_Node (Unit) & " added by " & Disp_Node (From));
end if;
end if;
@@ -424,13 +425,15 @@ package body Configuration is
if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then
Formal := Get_Association_Interface (Assoc);
Err := Err or Check_Open_Port (Formal, Assoc);
- if Flags.Warn_Binding and then not Get_Artificial_Flag (Assoc) then
+ if Is_Warning_Enabled (Warnid_Binding)
+ and then not Get_Artificial_Flag (Assoc)
+ then
Warning_Msg_Elab
(Disp_Node (Formal) & " of " & Disp_Node (Get_Parent (Formal))
- & " is not bound", Assoc);
+ & " is not bound", Assoc, Warnid_Binding);
Warning_Msg_Elab
("(in " & Disp_Node (Current_Configuration) & ")",
- Current_Configuration);
+ Current_Configuration, Warnid_Binding);
end if;
end if;
Assoc := Get_Chain (Assoc);
@@ -516,13 +519,13 @@ package body Configuration is
Inst : Iir;
begin
if Bind = Null_Iir then
- if Flags.Warn_Binding then
+ if Is_Warning_Enabled (Warnid_Binding) then
Inst := Get_First_Element (Get_Instantiation_List (Conf));
Warning_Msg_Elab
- (Disp_Node (Inst) & " is not bound", Conf);
+ (Disp_Node (Inst) & " is not bound", Conf, Warnid_Binding);
Warning_Msg_Elab
("(in " & Disp_Node (Current_Configuration) & ")",
- Current_Configuration);
+ Current_Configuration, Warnid_Binding);
end if;
return;
end if;
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index 0da1dc166..680160098 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -30,6 +30,51 @@ package body Errorout is
-- If True, disp original source line and a caret indicating the column.
Flag_Show_Caret : constant Boolean := False;
+ type Warning_Control_Type is record
+ Enabled : Boolean;
+ Error : Boolean;
+ end record;
+
+ type Warnings_Array is array (Msgid_Warnings) of Warning_Control_Type;
+
+ Warnings_Control : Warnings_Array :=
+ (Warnid_Binding => (Enabled => True, Error => False),
+ others => (Enabled => False, Error => False));
+
+ procedure Enable_Warning (Id : Msgid_Warnings; Enable : Boolean) is
+ begin
+ Warnings_Control (Id).Enabled := Enable;
+ end Enable_Warning;
+
+ function Is_Warning_Enabled (Id : Msgid_Warnings) return Boolean is
+ begin
+ return Warnings_Control (Id).Enabled;
+ end Is_Warning_Enabled;
+
+ function Warning_Image (Id : Msgid_Warnings) return String
+ is
+ Img : constant String := Msgid_Warnings'Image (Id);
+ Prefix : constant String := "WARNID_";
+ pragma Assert (Img'Length > Prefix'Length);
+ pragma Assert (Img (1 .. Prefix'Length) = Prefix);
+ Res : String (1 .. Img'Last - Prefix'Length);
+ C : Character;
+ begin
+ for I in Res'Range loop
+ C := Img (Prefix'Length + I);
+ case C is
+ when '_' =>
+ C := '-';
+ when 'A' .. 'Z' =>
+ C := Character'Val (Character'Pos (C) + 32);
+ when others =>
+ raise Internal_Error;
+ end case;
+ Res (I) := C;
+ end loop;
+ return Res;
+ end Warning_Image;
+
procedure Put (Str : String)
is
use Ada.Text_IO;
@@ -98,7 +143,7 @@ package body Errorout is
Put (':');
end Disp_Program_Name;
- procedure Report_Msg (Level : Report_Level;
+ procedure Report_Msg (Id : Msgid_Type;
Origin : Report_Origin;
Loc : Location_Type;
Msg : String)
@@ -173,18 +218,18 @@ package body Errorout is
Put ("??:??:??:");
end if;
- case Level is
- when Note =>
+ case Id is
+ when Msgid_Note =>
Put ("note:");
- when Warning =>
+ when Msgid_Warning | Msgid_Warnings =>
if Flags.Warn_Error then
Nbr_Errors := Nbr_Errors + 1;
else
Put ("warning:");
end if;
- when Error =>
+ when Msgid_Error =>
Nbr_Errors := Nbr_Errors + 1;
- when Fatal =>
+ when Msgid_Fatal =>
Put ("fatal:");
end case;
@@ -215,7 +260,7 @@ package body Errorout is
procedure Error_Msg_Option_NR (Msg: String) is
begin
- Report_Msg (Error, Option, No_Location, Msg);
+ Report_Msg (Msgid_Error, Option, No_Location, Msg);
end Error_Msg_Option_NR;
procedure Error_Msg_Option (Msg: String) is
@@ -233,67 +278,69 @@ package body Errorout is
end if;
end Get_Location_Safe;
- procedure Warning_Msg_Sem (Msg: String; Loc : Location_Type) is
+ procedure Warning_Msg_Sem
+ (Msg: String; Loc : Location_Type; Id : Msgid_Warnings) is
begin
if Flags.Flag_Only_Elab_Warnings then
return;
end if;
- Report_Msg (Warning, Semantic, Loc, Msg);
+ Report_Msg (Id, Semantic, Loc, Msg);
end Warning_Msg_Sem;
- procedure Warning_Msg_Sem (Msg: String; Loc : Iir) is
+ procedure Warning_Msg_Sem (Msg: String; Loc : Iir; Id : Msgid_Warnings) is
begin
- Warning_Msg_Sem (Msg, Get_Location_Safe (Loc));
+ Warning_Msg_Sem (Msg, Get_Location_Safe (Loc), Id);
end Warning_Msg_Sem;
- procedure Warning_Msg_Elab (Msg: String; Loc : Location_Type) is
+ procedure Warning_Msg_Elab
+ (Msg: String; Loc : Location_Type; Id : Msgid_Warnings) is
begin
- Report_Msg (Warning, Elaboration, Loc, Msg);
+ Report_Msg (Id, Elaboration, Loc, Msg);
end Warning_Msg_Elab;
- procedure Warning_Msg_Elab (Msg: String; Loc : Iir) is
+ procedure Warning_Msg_Elab (Msg: String; Loc : Iir; Id : Msgid_Warnings) is
begin
- Warning_Msg_Elab (Msg, Get_Location_Safe (Loc));
+ Warning_Msg_Elab (Msg, Get_Location_Safe (Loc), Id);
end Warning_Msg_Elab;
-- Disp a message during scan.
procedure Error_Msg_Scan (Msg: String) is
begin
- Report_Msg (Error, Scan, No_Location, Msg);
+ Report_Msg (Msgid_Error, Scan, No_Location, Msg);
end Error_Msg_Scan;
procedure Error_Msg_Scan (Msg: String; Loc : Location_Type) is
begin
- Report_Msg (Error, Scan, Loc, Msg);
+ Report_Msg (Msgid_Error, Scan, Loc, Msg);
end Error_Msg_Scan;
-- Disp a message during scan.
- procedure Warning_Msg_Scan (Msg: String) is
+ procedure Warning_Msg_Scan (Msg: String; Id : Msgid_Warnings) is
begin
- Report_Msg (Warning, Scan, No_Location, Msg);
+ Report_Msg (Id, Scan, No_Location, Msg);
end Warning_Msg_Scan;
-- Disp a message during scan.
procedure Error_Msg_Parse (Msg: String) is
begin
- Report_Msg (Error, Parse, No_Location, Msg);
+ Report_Msg (Msgid_Error, Parse, No_Location, Msg);
end Error_Msg_Parse;
procedure Error_Msg_Parse (Msg: String; Loc : Iir) is
begin
- Report_Msg (Error, Parse, Get_Location_Safe (Loc), Msg);
+ Report_Msg (Msgid_Error, Parse, Get_Location_Safe (Loc), Msg);
end Error_Msg_Parse;
procedure Error_Msg_Parse (Msg: String; Loc : Location_Type) is
begin
- Report_Msg (Error, Parse, Loc, Msg);
+ Report_Msg (Msgid_Error, Parse, Loc, Msg);
end Error_Msg_Parse;
-- Disp a message during semantic analysis.
-- LOC is used for location and current token.
procedure Error_Msg_Sem (Msg: String; Loc: in Iir) is
begin
- Report_Msg (Error, Semantic, Get_Location_Safe (Loc), Msg);
+ Report_Msg (Msgid_Error, Semantic, Get_Location_Safe (Loc), Msg);
end Error_Msg_Sem;
procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node)
@@ -306,24 +353,24 @@ package body Errorout is
else
L := PSL.Nodes.Get_Location (Loc);
end if;
- Report_Msg (Error, Semantic, L, Msg);
+ Report_Msg (Msgid_Error, Semantic, L, Msg);
end Error_Msg_Sem;
procedure Error_Msg_Sem (Msg: String; Loc : Location_Type) is
begin
- Report_Msg (Error, Semantic, Loc, Msg);
+ Report_Msg (Msgid_Error, Semantic, Loc, Msg);
end Error_Msg_Sem;
procedure Error_Msg_Relaxed
(Origin : Report_Origin; Msg : String; Loc : Iir)
is
use Flags;
- Level : Report_Level;
+ Level : Msgid_Type;
begin
if Flag_Relaxed_Rules or Vhdl_Std = Vhdl_93c then
- Level := Warning;
+ Level := Msgid_Warning;
else
- Level := Error;
+ Level := Msgid_Error;
end if;
Report_Msg (Level, Origin, Get_Location_Safe (Loc), Msg);
end Error_Msg_Relaxed;
@@ -336,12 +383,12 @@ package body Errorout is
-- Disp a message during elaboration.
procedure Error_Msg_Elab (Msg: String) is
begin
- Report_Msg (Error, Elaboration, No_Location, Msg);
+ Report_Msg (Msgid_Error, Elaboration, No_Location, Msg);
end Error_Msg_Elab;
procedure Error_Msg_Elab (Msg: String; Loc : Iir) is
begin
- Report_Msg (Error, Elaboration, Get_Location_Safe (Loc), Msg);
+ Report_Msg (Msgid_Error, Elaboration, Get_Location_Safe (Loc), Msg);
end Error_Msg_Elab;
-- Disp a bug message.
diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads
index ab7b3fcc2..c1d219011 100644
--- a/src/vhdl/errorout.ads
+++ b/src/vhdl/errorout.ads
@@ -33,14 +33,90 @@ package Errorout is
-- The number of errors (ie, number of calls to error_msg*).
Nbr_Errors: Natural := 0;
- type Report_Level is (Note, Warning, Error, Fatal);
+ type Msgid_Type is
+ (-- Any note
+ Msgid_Note,
+
+ -- Any warning
+ Msgid_Warning,
+
+ -- Specific warnings
+
+ -- Design unit redefines another design unit.
+ Warnid_Library,
+
+ -- Missing Xref in pretty print.
+ Warnid_Missing_Xref,
+
+ -- No default binding for a component instantiation.
+ Warnid_Default_Binding,
+
+ -- Unbound component.
+ Warnid_Binding,
+
+ -- Vhdl93 reserved word is used as a vhdl87 identifier.
+ Warnid_Reserved_Word,
+
+ -- Start of block comment ('/*') appears in a block comment.
+ Warnid_Nested_Comment,
+
+ -- Weird use of parenthesis.
+ Warnid_Parenthesis,
+
+ -- Generic of a vital entity is not a vital name.
+ Warnid_Vital_Generic,
+
+ -- Delayed checks (checks performed at elaboration time).
+ Warnid_Delayed_Checks,
+
+ -- Package body is not required but is analyzed.
+ Warnid_Body,
+
+ -- An all/others specification does not apply, because there is no such
+ -- named entities.
+ Warnid_Specs,
+
+ -- Incorrect use of universal value.
+ Warnid_Universal,
+
+ -- Runtime error detected at analysis time.
+ Warnid_Runtime_Error,
+
+ -- Signal assignment creates a delta cycle in a postponed process.
+ Warnid_Delta_Cycle,
+
+ -- Emit a warning when a declaration is never used.
+ -- FIXME: currently only subprograms are handled.
+ Warnid_Unused,
+
+ -- Any error
+ Msgid_Error,
+
+ -- Any fatal error
+ Msgid_Fatal);
+
+ -- All specific warning messages.
+ subtype Msgid_Warnings is Msgid_Type
+ range Warnid_Library .. Warnid_Unused;
+
+ -- Get the image of a warning. This correspond the the identifier of ID,
+ -- in lower case, without the Msgid_Warn_ prefix and with '_' replaced
+ -- by '-'.
+ function Warning_Image (Id : Msgid_Warnings) return String;
+
+ -- Enable or disable a warning.
+ procedure Enable_Warning (Id : Msgid_Warnings; Enable : Boolean);
+
+ -- Get enable status of a warning.
+ function Is_Warning_Enabled (Id : Msgid_Warnings) return Boolean;
+
type Report_Origin is
(Option, Library, Scan, Parse, Semantic, Elaboration);
-- Generic report message. LOC maybe No_Location.
-- If ORIGIN is Option or Library, LOC must be No_Location and the program
-- name is displayed.
- procedure Report_Msg (Level : Report_Level;
+ procedure Report_Msg (Id : Msgid_Type;
Origin : Report_Origin;
Loc : Location_Type;
Msg : String);
@@ -55,14 +131,15 @@ package Errorout is
procedure Error_Msg_Option_NR (Msg: String);
-- Disp a warning.
- procedure Warning_Msg_Sem (Msg: String; Loc : Iir);
- procedure Warning_Msg_Sem (Msg: String; Loc : Location_Type);
+ procedure Warning_Msg_Sem (Msg: String; Loc : Iir; Id : Msgid_Warnings);
+ procedure Warning_Msg_Sem
+ (Msg: String; Loc : Location_Type; Id : Msgid_Warnings);
-- Disp a message during scan.
-- The current location is automatically displayed before the message.
procedure Error_Msg_Scan (Msg: String);
procedure Error_Msg_Scan (Msg: String; Loc : Location_Type);
- procedure Warning_Msg_Scan (Msg: String);
+ procedure Warning_Msg_Scan (Msg: String; Id : Msgid_Warnings);
-- Disp a message during parse
-- The location of the current token is automatically displayed before
@@ -85,7 +162,7 @@ package Errorout is
procedure Error_Msg_Elab (Msg: String; Loc: Iir);
-- Disp a warning durig elaboration (or configuration).
- procedure Warning_Msg_Elab (Msg: String; Loc : Iir);
+ procedure Warning_Msg_Elab (Msg: String; Loc : Iir; Id : Msgid_Warnings);
-- Disp a bug message.
procedure Error_Internal (Expr: Iir; Msg: String := "");
diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index bd3b9e286..e0b52fd9f 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -560,7 +560,8 @@ package body Evaluation is
exception
when Constraint_Error =>
-- Can happen for absolute.
- Warning_Msg_Sem ("arithmetic overflow in static expression", Orig);
+ Warning_Msg_Sem ("arithmetic overflow in static expression",
+ Orig, Warnid_Runtime_Error);
return Build_Overflow (Orig);
end Eval_Monadic_Operator;
@@ -579,7 +580,8 @@ package body Evaluation is
begin
Len := Get_String_Length (Left);
if Len /= Get_String_Length (Right) then
- Warning_Msg_Sem ("length of left and right operands mismatch", Expr);
+ Warning_Msg_Sem ("length of left and right operands mismatch",
+ Expr, Warnid_Runtime_Error);
return Build_Overflow (Expr);
else
Id := Create_String8;
@@ -678,7 +680,7 @@ package body Evaluation is
is
begin
if Get_Value (Val) = 0 then
- Warning_Msg_Sem ("division by 0", Expr);
+ Warning_Msg_Sem ("division by 0", Expr, Warnid_Runtime_Error);
return False;
else
return True;
@@ -1125,7 +1127,8 @@ package body Evaluation is
(Get_Fp_Value (Left) * Get_Fp_Value (Right), Orig);
when Iir_Predefined_Floating_Div =>
if Get_Fp_Value (Right) = 0.0 then
- Warning_Msg_Sem ("right operand of division is 0", Orig);
+ Warning_Msg_Sem ("right operand of division is 0",
+ Orig, Warnid_Runtime_Error);
return Build_Overflow (Orig);
else
return Build_Floating
@@ -1452,7 +1455,8 @@ package body Evaluation is
end case;
exception
when Constraint_Error =>
- Warning_Msg_Sem ("arithmetic overflow in static expression", Orig);
+ Warning_Msg_Sem ("arithmetic overflow in static expression",
+ Orig, Warnid_Runtime_Error);
return Build_Overflow (Orig);
end Eval_Dyadic_Operator;
@@ -1646,7 +1650,7 @@ package body Evaluation is
return Build_Constant (Res, Expr);
else
Warning_Msg_Sem ("value """ & Value & """ not in enumeration "
- & Disp_Node (Enum), Expr);
+ & Disp_Node (Enum), Expr, Warnid_Runtime_Error);
return Build_Overflow (Expr);
end if;
end Build_Enumeration_Value;
@@ -1720,7 +1724,8 @@ package body Evaluation is
end loop;
if Unit = Null_Iir then
Warning_Msg_Sem ("Unit """ & UnitName (Sep + 1 .. UnitName'Last)
- & """ not in physical type", Expr);
+ & """ not in physical type",
+ Expr, Warnid_Runtime_Error);
return Build_Overflow (Expr);
end if;
@@ -1803,7 +1808,8 @@ package body Evaluation is
(Get_Enumeration_Literal_List
(Get_Base_Type (Get_Type (Expr))))))
then
- Warning_Msg_Sem ("static constant violates bounds", Expr);
+ Warning_Msg_Sem ("static constant violates bounds",
+ Expr, Warnid_Runtime_Error);
return Build_Overflow (Origin);
else
return Build_Enumeration (Iir_Index32 (P), Origin);
@@ -1861,8 +1867,8 @@ package body Evaluation is
if Get_Constraint_State (Conv_Type) = Fully_Constrained then
Set_Type (Res, Conv_Type);
if not Eval_Is_In_Bound (Val, Conv_Type) then
- Warning_Msg_Sem
- ("non matching length in type conversion", Conv);
+ Warning_Msg_Sem ("non matching length in type conversion",
+ Conv, Warnid_Runtime_Error);
return Build_Overflow (Conv);
end if;
return Res;
@@ -1931,7 +1937,8 @@ package body Evaluation is
end if;
if not Eval_Is_In_Bound (Res, Get_Type (Expr)) then
if Get_Kind (Res) /= Iir_Kind_Overflow_Literal then
- Warning_Msg_Sem ("result of conversion out of bounds", Expr);
+ Warning_Msg_Sem ("result of conversion out of bounds",
+ Expr, Warnid_Runtime_Error);
Res := Build_Overflow (Res);
end if;
end if;
@@ -2117,8 +2124,8 @@ package body Evaluation is
and then
not Eval_Int_In_Range (Val, Get_Range_Constraint (Expr_Type))
then
- Warning_Msg_Sem
- ("static argument out of the type range", Expr);
+ Warning_Msg_Sem ("static argument out of the type range",
+ Expr, Warnid_Runtime_Error);
return Build_Overflow (Expr);
end if;
if Get_Kind (Get_Base_Type (Get_Type (Expr)))
@@ -2166,7 +2173,8 @@ package body Evaluation is
Set_Parameter (Expr, Param);
if Get_Kind (Param) /= Iir_Kind_String_Literal8 then
-- FIXME: Isn't it an implementation restriction.
- Warning_Msg_Sem ("'value argument not a string", Expr);
+ Warning_Msg_Sem ("'value argument not a string",
+ Expr, Warnid_Runtime_Error);
return Build_Overflow (Expr);
else
return Eval_Value_Attribute
diff --git a/src/vhdl/ieee-vital_timing.adb b/src/vhdl/ieee-vital_timing.adb
index 915ad00a6..fb92efaf7 100644
--- a/src/vhdl/ieee-vital_timing.adb
+++ b/src/vhdl/ieee-vital_timing.adb
@@ -27,7 +27,6 @@ with Sem_Specs;
with Evaluation;
with Sem;
with Iirs_Utils;
-with Flags;
package body Ieee.Vital_Timing is
-- This package is based on IEEE 1076.4 1995.
@@ -189,7 +188,11 @@ package body Ieee.Vital_Timing is
procedure Error_Vital (Msg : String; Loc : Iir) renames Error_Msg_Sem;
procedure Error_Vital (Msg : String; Loc : Location_Type)
renames Error_Msg_Sem;
- procedure Warning_Vital (Msg : String; Loc : Iir) renames Warning_Msg_Sem;
+
+ procedure Warning_Vital (Msg : String; Loc : Iir) is
+ begin
+ Warning_Msg_Sem (Msg, Loc, Warnid_Vital_Generic);
+ end Warning_Vital;
-- Check DECL is the VITAL level 0 attribute specification.
procedure Check_Level0_Attribute_Specification (Decl : Iir)
@@ -1255,7 +1258,7 @@ package body Ieee.Vital_Timing is
return;
end if;
- if Flags.Warn_Vital_Generic then
+ if Is_Warning_Enabled (Warnid_Vital_Generic) then
Warning_Vital (Disp_Node (Decl) & " is not a VITAL generic", Decl);
end if;
end Check_Entity_Generic_Declaration;
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index eaab1351f..6991b8c7b 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -4072,7 +4072,8 @@ package body Parse is
-- Parenthesis around aggregate is useless and change the
-- context for array aggregate.
Warning_Msg_Sem
- ("suspicious parenthesis around aggregate", Expr);
+ ("suspicious parenthesis around aggregate",
+ Expr, Warnid_Parenthesis);
elsif not Flag_Parse_Parenthesis then
return Expr;
end if;
diff --git a/src/vhdl/scanner.adb b/src/vhdl/scanner.adb
index b56c04e9a..7c5dbdd00 100644
--- a/src/vhdl/scanner.adb
+++ b/src/vhdl/scanner.adb
@@ -931,39 +931,44 @@ package body Scanner is
case Current_Identifier is
when Std_Names.Name_Id_AMS_Reserved_Words =>
if not AMS_Vhdl then
- if Flags.Warn_Reserved_Word then
+ if Is_Warning_Enabled (Warnid_Reserved_Word) then
Warning_Msg_Scan
("using """ & Nam_Buffer (1 .. Nam_Length)
- & """ AMS-VHDL reserved word as an identifier");
+ & """ AMS-VHDL reserved word as an identifier",
+ Warnid_Reserved_Word);
end if;
Current_Token := Tok_Identifier;
end if;
when Std_Names.Name_Id_Vhdl08_Reserved_Words =>
if Vhdl_Std < Vhdl_08 then
- if Flags.Warn_Reserved_Word then
+ if Is_Warning_Enabled (Warnid_Reserved_Word) then
Warning_Msg_Scan
("using """ & Nam_Buffer (1 .. Nam_Length)
- & """ vhdl-2008 reserved word as an identifier");
+ & """ vhdl-2008 reserved word as an identifier",
+ Warnid_Reserved_Word);
end if;
Current_Token := Tok_Identifier;
end if;
when Std_Names.Name_Id_Vhdl00_Reserved_Words =>
if Vhdl_Std < Vhdl_00 then
- if Flags.Warn_Reserved_Word then
+ if Is_Warning_Enabled (Warnid_Reserved_Word) then
Warning_Msg_Scan
("using """ & Nam_Buffer (1 .. Nam_Length)
- & """ vhdl00 reserved word as an identifier");
+ & """ vhdl00 reserved word as an identifier",
+ Warnid_Reserved_Word);
end if;
Current_Token := Tok_Identifier;
end if;
when Std_Names.Name_Id_Vhdl93_Reserved_Words =>
if Vhdl_Std = Vhdl_87 then
- if Flags.Warn_Reserved_Word then
+ if Is_Warning_Enabled (Warnid_Reserved_Word) then
Warning_Msg_Scan
("using """ & Nam_Buffer (1 .. Nam_Length)
- & """ vhdl93 reserved word as a vhdl87 identifier");
+ & """ vhdl93 reserved word as a vhdl87 identifier",
+ Warnid_Reserved_Word);
Warning_Msg_Scan
- ("(use option --std=93 to compile as vhdl93)");
+ ("(use option --std=93 to compile as vhdl93)",
+ Warnid_Reserved_Word);
end if;
Current_Token := Tok_Identifier;
end if;
@@ -1464,7 +1469,8 @@ package body Scanner is
-- the start of a nested delimited comment.
if Source (Pos + 1) = '*' then
Warning_Msg_Scan
- ("'/*' found within a block comment");
+ ("'/*' found within a block comment",
+ Warnid_Nested_Comment);
end if;
Pos := Pos + 1;
when '*' =>
diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index 4c31f3673..d19061846 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -2463,14 +2463,15 @@ package body Sem is
Warning_Msg_Sem
("can't assert that all calls in " & Disp_Node (El)
& " are pure or have not wait; "
- & "will be checked at elaboration", El);
+ & "will be checked at elaboration", El,
+ Warnid_Delayed_Checks);
Callee := Get_Nth_Element (Callees, 0);
-- FIXME: could improve this message by displaying the
-- chain of calls until the first subprograms in
-- unknown state.
Warning_Msg_Sem
("(first such call is to " & Disp_Node (Callee) & ")",
- Callee);
+ Callee, Warnid_Delayed_Checks);
end if;
end if;
when Iir_Kind_Sensitized_Process_Statement =>
@@ -2479,7 +2480,8 @@ package body Sem is
if Emit_Warnings then
Warning_Msg_Sem
("can't assert that " & Disp_Node (El)
- & " has not wait; will be checked at elaboration", El);
+ & " has not wait; will be checked at elaboration",
+ El, Warnid_Delayed_Checks);
end if;
end if;
when others =>
@@ -2633,7 +2635,8 @@ package body Sem is
-- Emit a warning is a body is not necessary.
if not Get_Need_Body (Package_Decl) then
Warning_Msg_Sem
- (Disp_Node (Package_Decl) & " does not require a body", Decl);
+ (Disp_Node (Package_Decl) & " does not require a body",
+ Decl, Warnid_Body);
end if;
Set_Package (Decl, Package_Decl);
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index e05f2c552..48c3ae2d9 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -2995,7 +2995,7 @@ package body Sem_Decls is
-- Set Check_Unused.
Check_Unused := False;
- if Flags.Warn_Unused then
+ if Is_Warning_Enabled (Warnid_Unused) then
case Get_Kind (Decl) is
when Iir_Kind_Entity_Declaration =>
-- May be used in architecture.
@@ -3079,7 +3079,8 @@ package body Sem_Decls is
and then not Is_Second_Subprogram_Specification (El)
then
Warning_Msg_Sem
- (Disp_Node (El) & " is never referenced", El);
+ (Disp_Node (El) & " is never referenced", El,
+ Warnid_Unused);
end if;
when others =>
null;
diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index a856be072..10e07bf22 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -863,7 +863,7 @@ package body Sem_Expr is
-- Be tolerant.
Warning_Msg_Sem ("universal integer bound must be numeric literal "
- & "or attribute", Res);
+ & "or attribute", Res, Warnid_Universal);
else
Error_Msg_Sem ("universal integer bound must be numeric literal "
& "or attribute", Res);
@@ -3431,7 +3431,9 @@ package body Sem_Expr is
if not Eval_Is_In_Bound (Expr, Element_Type)
then
Info.Has_Bound_Error := True;
- Warning_Msg_Sem ("element is out of the bounds", Expr);
+ Warning_Msg_Sem
+ ("element is out of the bounds", Expr,
+ Warnid_Runtime_Error);
end if;
-- FIXME: handle name/others in translate.
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index 006390332..098268daa 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -735,7 +735,8 @@ package body Sem_Names is
if False and then Flags.Vhdl_Std = Vhdl_87 then
-- emit a warning for a null slice.
Warning_Msg_Sem
- ("direction mismatch results in a null slice", Name);
+ ("direction mismatch results in a null slice",
+ Name, Warnid_Runtime_Error);
end if;
Error_Msg_Sem ("direction of the range mismatch", Name);
end if;
diff --git a/src/vhdl/sem_specs.adb b/src/vhdl/sem_specs.adb
index bdcf64563..8b4a525f0 100644
--- a/src/vhdl/sem_specs.adb
+++ b/src/vhdl/sem_specs.adb
@@ -770,9 +770,10 @@ package body Sem_Specs is
-- class that are declared in the immediatly enclosing
-- declarative part.
Res := Sem_Named_Entities (Scope, Null_Iir, Spec, False, True);
- if Res = False and then Flags.Warn_Specs then
+ if Res = False and then Is_Warning_Enabled (Warnid_Specs) then
Warning_Msg_Sem
- ("attribute specification apply to no named entity", Spec);
+ ("attribute specification apply to no named entity",
+ Spec, Warnid_Specs);
end if;
elsif List = Iir_List_Others then
-- o If the reserved word OTHERS is supplied, then the attribute
@@ -782,9 +783,10 @@ package body Sem_Specs is
-- in the entity name list of a previous attribute specification
-- for the given attribute.
Res := Sem_Named_Entities (Scope, Null_Iir, Spec, False, False);
- if Res = False and then Flags.Warn_Specs then
+ if Res = False and then Is_Warning_Enabled (Warnid_Specs) then
Warning_Msg_Sem
- ("attribute specification apply to no named entity", Spec);
+ ("attribute specification apply to no named entity",
+ Spec, Warnid_Specs);
end if;
else
-- o If a list of entity designators is supplied, then the
@@ -1337,10 +1339,10 @@ package body Sem_Specs is
-- statements whose corresponding instantiated units name
-- component.
if not Apply_Component_Specification (Parent_Stmts, False)
- and then Flags.Warn_Specs
+ and then Is_Warning_Enabled (Warnid_Specs)
then
- Warning_Msg_Sem
- ("component specification applies to no instance", Spec);
+ Warning_Msg_Sem ("component specification applies to no instance",
+ Spec, Warnid_Specs);
end if;
elsif List = Iir_List_Others then
-- LRM93 5.2
@@ -1355,10 +1357,10 @@ package body Sem_Specs is
-- statements whose corresponding instantiated units name
-- components.
if not Apply_Component_Specification (Parent_Stmts, True)
- and then Flags.Warn_Specs
+ and then Is_Warning_Enabled (Warnid_Specs)
then
- Warning_Msg_Sem
- ("component specification applies to no instance", Spec);
+ Warning_Msg_Sem ("component specification applies to no instance",
+ Spec, Warnid_Specs);
end if;
else
-- LRM93 5.2
@@ -1787,7 +1789,8 @@ package body Sem_Specs is
-- (see 10.3),
Decl := Get_Declaration (Inter);
Warning_Msg_Elab ("visible declaration for " & Name_Table.Image (Name)
- & " is " & Disp_Node (Decl), Decl);
+ & " is " & Disp_Node (Decl),
+ Decl, Warnid_Default_Binding);
-- b) An entity declaration that has the same simple name that of
-- the instantiated component and that would be directly
@@ -1798,8 +1801,9 @@ package body Sem_Specs is
Inter := Get_Under_Interpretation (Name);
if Valid_Interpretation (Inter) then
Decl := Get_Declaration (Inter);
- Warning_Msg_Elab ("interpretation behind the component is "
- & Disp_Node (Decl), Comp);
+ Warning_Msg_Elab
+ ("interpretation behind the component is " & Disp_Node (Decl),
+ Comp, Warnid_Default_Binding);
end if;
end if;
end if;
@@ -1819,7 +1823,7 @@ package body Sem_Specs is
end loop;
Warning_Msg_Elab ("no entity """ & Name_Table.Image (Name) & """ in "
- & Disp_Node (Decl), Comp);
+ & Disp_Node (Decl), Comp, Warnid_Default_Binding);
end if;
end Explain_No_Visible_Entity;
diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb
index d0ca64a06..25c1ada95 100644
--- a/src/vhdl/sem_stmts.adb
+++ b/src/vhdl/sem_stmts.adb
@@ -557,7 +557,7 @@ package body Sem_Stmts is
if Get_Postponed_Flag (Current_Concurrent_Statement) then
Warning_Msg_Sem
("waveform may cause a delta cycle in a " &
- "postponed process", We);
+ "postponed process", We, Warnid_Delta_Cycle);
end if;
when others =>
-- Context is a subprogram.
@@ -833,7 +833,7 @@ package body Sem_Stmts is
then
Warning_Msg_Sem
("expression length does not match target length",
- Stmt);
+ Stmt, Warnid_Runtime_Error);
Set_Expression (Stmt, Build_Overflow (Expr, Target_Type));
end if;
end if;
@@ -1499,11 +1499,12 @@ package body Sem_Stmts is
then
Entity_Unit := Get_Visible_Entity_Declaration (Decl);
if Entity_Unit = Null_Iir then
- if Flags.Warn_Default_Binding
+ if Is_Warning_Enabled (Warnid_Default_Binding)
and then not Flags.Flag_Elaborate
then
- Warning_Msg_Sem ("no default binding for instantiation of "
- & Disp_Node (Decl), Stmt);
+ Warning_Msg_Sem
+ ("no default binding for instantiation of "
+ & Disp_Node (Decl), Stmt, Warnid_Default_Binding);
Explain_No_Visible_Entity (Decl);
end if;
elsif Flags.Flag_Elaborate
diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb
index a4919147c..b5f948038 100644
--- a/src/vhdl/simulate/elaboration.adb
+++ b/src/vhdl/simulate/elaboration.adb
@@ -1891,7 +1891,8 @@ package body Elaboration is
-- declaration and architecture body or is bound to a configuration of
-- such a design entity.
if not Is_Fully_Bound (Conf) then
- Warning_Msg_Elab (Disp_Node (Stmt) & " not bound", Stmt);
+ Warning_Msg_Elab
+ (Disp_Node (Stmt) & " not bound", Stmt, Warnid_Binding);
return;
end if;
diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb
index 46f303348..2c3da3189 100644
--- a/src/vhdl/translate/ortho_front.adb
+++ b/src/vhdl/translate/ortho_front.adb
@@ -391,7 +391,7 @@ package body Ortho_Front is
Design := Get_First_Design_Unit (New_Design_File);
while not Is_Null (Design) loop
Sem.Sem_Analysis_Checks_List
- (Design, Flags.Warn_Delayed_Checks);
+ (Design, Is_Warning_Enabled (Warnid_Delayed_Checks));
Design := Get_Chain (Design);
end loop;
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 8706dd3b3..e1ae36901 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -3784,7 +3784,8 @@ package body Trans.Chap7 is
return New_Lit (New_Signed_Literal (Otype, Integer_64 (Val)));
exception
when Constraint_Error =>
- Warning_Msg_Elab ("physical literal out of range", Expr);
+ Warning_Msg_Elab ("physical literal out of range",
+ Expr, Warnid_Runtime_Error);
return Translate_Overflow_Literal (Expr);
end;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 10:55:47 +0000