From ee0e651d9b3946910d513e6a670453e25e5f014d Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Tue, 2 Aug 2016 06:02:07 +0200
Subject: Rewrite error messages.
---
src/vhdl/errorout.adb | 65 +++++++---
src/vhdl/errorout.ads | 17 ++-
src/vhdl/evaluation.adb | 8 +-
src/vhdl/ieee-std_logic_1164.adb | 2 +-
src/vhdl/ieee-vital_timing.adb | 130 ++++++++++----------
src/vhdl/parse.adb | 7 +-
src/vhdl/psl-errors.ads | 2 +-
src/vhdl/sem.adb | 184 ++++++++++++++--------------
src/vhdl/sem_assocs.adb | 157 ++++++++++++------------
src/vhdl/sem_decls.adb | 189 ++++++++++++++---------------
src/vhdl/sem_expr.adb | 210 +++++++++++++++-----------------
src/vhdl/sem_names.adb | 241 +++++++++++++++++--------------------
src/vhdl/sem_psl.adb | 32 ++---
src/vhdl/sem_scopes.adb | 14 +--
src/vhdl/sem_specs.adb | 152 +++++++++++------------
src/vhdl/sem_stmts.adb | 178 +++++++++++++--------------
src/vhdl/sem_types.adb | 202 +++++++++++++++----------------
src/vhdl/simulate/elaboration.adb | 7 +-
src/vhdl/translate/trans-chap1.adb | 2 +-
src/vhdl/translate/trans-chap3.adb | 3 +-
src/vhdl/translate/trans_be.adb | 2 +-
src/vhdl/translate/translation.adb | 10 +-
22 files changed, 897 insertions(+), 917 deletions(-)
(limited to 'src/vhdl')
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index afb7be49d..6c08e7328 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -111,6 +111,17 @@ package body Errorout is
function "+" (L : Iir) return Location_Type renames Get_Location_Safe;
+ function "+" (L : PSL_Node) return Location_Type
+ is
+ use PSL.Nodes;
+ begin
+ if L = Null_Node then
+ return No_Location;
+ else
+ return PSL.Nodes.Get_Location (L);
+ end if;
+ end "+";
+
procedure Put (Str : String)
is
use Ada.Text_IO;
@@ -381,6 +392,21 @@ package body Errorout is
Put (':');
Disp_Natural (Arg_Col);
end;
+ when 'n' =>
+ -- Node
+ declare
+ Arg : Earg_Type renames Args (Argn);
+ begin
+ Put (''');
+ case Arg.Kind is
+ when Earg_Iir =>
+ Put (Disp_Node (Arg.Val_Iir));
+ when others =>
+ -- Invalid conversion to node.
+ raise Internal_Error;
+ end case;
+ Put (''');
+ end;
when others =>
-- Unknown format.
raise Internal_Error;
@@ -501,26 +527,29 @@ package body Errorout is
Report_Msg (Msgid_Error, Semantic, Get_Location_Safe (Loc), Msg);
end Error_Msg_Sem;
- procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node)
- is
- use PSL.Nodes;
- L : Location_Type;
+ procedure Error_Msg_Sem (Loc: Location_Type;
+ Msg: String;
+ Args : Earg_Arr := No_Eargs;
+ Cont : Boolean := False) is
begin
- if Loc = Null_Node then
- L := No_Location;
- else
- L := PSL.Nodes.Get_Location (Loc);
- end if;
- Report_Msg (Msgid_Error, Semantic, L, Msg);
+ Report_Msg (Msgid_Error, Semantic, Loc, Msg, Args, Cont);
end Error_Msg_Sem;
- procedure Error_Msg_Sem (Msg: String; Loc : Location_Type) is
+ procedure Error_Msg_Sem
+ (Loc: Location_Type; Msg: String; Arg1 : Earg_Type) is
begin
- Report_Msg (Msgid_Error, Semantic, Loc, Msg);
+ Report_Msg (Msgid_Error, Semantic, Loc, Msg, (1 => Arg1));
end Error_Msg_Sem;
- procedure Error_Msg_Relaxed
- (Origin : Report_Origin; Msg : String; Loc : Iir)
+ procedure Error_Msg_Sem_1 (Msg: String; Loc : PSL_Node) is
+ begin
+ Error_Msg_Sem (+Loc, Msg);
+ end Error_Msg_Sem_1;
+
+ procedure Error_Msg_Relaxed (Origin : Report_Origin;
+ Msg : String;
+ Loc : Iir;
+ Args : Earg_Arr := No_Eargs)
is
use Flags;
Level : Msgid_Type;
@@ -530,12 +559,14 @@ package body Errorout is
else
Level := Msgid_Error;
end if;
- Report_Msg (Level, Origin, Get_Location_Safe (Loc), Msg);
+ Report_Msg (Level, Origin, Get_Location_Safe (Loc), Msg, Args);
end Error_Msg_Relaxed;
- procedure Error_Msg_Sem_Relaxed (Loc : Iir; Msg : String) is
+ procedure Error_Msg_Sem_Relaxed (Loc : Iir;
+ Msg : String;
+ Args : Earg_Arr := No_Eargs) is
begin
- Error_Msg_Relaxed (Semantic, Msg, Loc);
+ Error_Msg_Relaxed (Semantic, Msg, Loc, Args);
end Error_Msg_Sem_Relaxed;
-- Disp a message during elaboration.
diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads
index 16f26df22..e1beb156b 100644
--- a/src/vhdl/errorout.ads
+++ b/src/vhdl/errorout.ads
@@ -123,6 +123,8 @@ package Errorout is
-- %c: character
-- %t: token
-- %l: location
+ -- %n: node name
+ -- TODO: %m: mode, %y: type of, %s: disp_subprg
function "+" (V : Iir) return Earg_Type;
function "+" (V : Location_Type) return Earg_Type;
function "+" (V : Name_Id) return Earg_Type;
@@ -131,6 +133,7 @@ package Errorout is
-- Convert location.
function "+" (L : Iir) return Location_Type;
+ function "+" (L : PSL_Node) return Location_Type;
-- Pass that detected the error.
type Report_Origin is
@@ -179,12 +182,18 @@ package Errorout is
procedure Warning_Msg_Sem
(Id : Msgid_Warnings; Loc : Location_Type; Msg: String);
- procedure Error_Msg_Sem (Msg: String; Loc: Iir);
- procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node);
- procedure Error_Msg_Sem (Msg: String; Loc: Location_Type);
+ procedure Error_Msg_Sem (Loc: Location_Type;
+ Msg: String;
+ Args : Earg_Arr := No_Eargs;
+ Cont : Boolean := False);
+ procedure Error_Msg_Sem
+ (Loc: Location_Type; Msg: String; Arg1 : Earg_Type);
+ procedure Error_Msg_Sem_1 (Msg: String; Loc : PSL_Node);
-- Like Error_Msg_Sem, but a warning if -frelaxed or --std=93c.
- procedure Error_Msg_Sem_Relaxed (Loc : Iir; Msg : String);
+ procedure Error_Msg_Sem_Relaxed (Loc : Iir;
+ Msg : String;
+ Args : Earg_Arr := No_Eargs);
-- Disp a message during elaboration (or configuration).
procedure Error_Msg_Elab (Msg: String);
diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index 952f05cd0..3b89eb14f 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -323,7 +323,7 @@ package body Evaluation is
if Len > 0
and then not Eval_Int_In_Range (Pos, Get_Range_Constraint (A_Type))
then
- Error_Msg_Sem ("range length is beyond subtype length", A_Range);
+ Error_Msg_Sem (+A_Range, "range length is beyond subtype length");
Right := Left;
else
-- FIXME: what about nul range?
@@ -2361,7 +2361,7 @@ package body Evaluation is
function Eval_Expr (Expr: Iir) return Iir is
begin
if Get_Expr_Staticness (Expr) /= Locally then
- Error_Msg_Sem ("expression must be locally static", Expr);
+ Error_Msg_Sem (+Expr, "expression must be locally static");
return Expr;
else
return Eval_Expr_Keep_Orig (Expr, False);
@@ -2619,7 +2619,7 @@ package body Evaluation is
end if;
if not Eval_Is_In_Bound (Expr, Sub_Type) then
- Error_Msg_Sem ("static constant violates bounds", Expr);
+ Error_Msg_Sem (+Expr, "static constant violates bounds");
end if;
end Eval_Check_Bound;
@@ -2695,7 +2695,7 @@ package body Evaluation is
is
begin
if not Eval_Is_Range_In_Bound (A_Range, Sub_Type, Any_Dir) then
- Error_Msg_Sem ("static range violates bounds", A_Range);
+ Error_Msg_Sem (+A_Range, "static range violates bounds");
end if;
end Eval_Check_Range;
diff --git a/src/vhdl/ieee-std_logic_1164.adb b/src/vhdl/ieee-std_logic_1164.adb
index 8780bf9d8..b24e868d8 100644
--- a/src/vhdl/ieee-std_logic_1164.adb
+++ b/src/vhdl/ieee-std_logic_1164.adb
@@ -307,7 +307,7 @@ package body Ieee.Std_Logic_1164 is
exception
when Error =>
- Error_Msg_Sem ("package ieee.std_logic_1164 is ill-formed", Pkg);
+ Error_Msg_Sem (+Pkg, "package ieee.std_logic_1164 is ill-formed");
-- Clear all definitions.
Std_Logic_1164_Pkg := Null_Iir;
diff --git a/src/vhdl/ieee-vital_timing.adb b/src/vhdl/ieee-vital_timing.adb
index 5f5af94b6..12811be38 100644
--- a/src/vhdl/ieee-vital_timing.adb
+++ b/src/vhdl/ieee-vital_timing.adb
@@ -169,7 +169,7 @@ package body Ieee.Vital_Timing is
exception
when Ill_Formed =>
- Error_Msg_Sem ("package ieee.vital_timing is ill-formed", Pkg);
+ Error_Msg_Sem (+Pkg, "package ieee.vital_timing is ill-formed");
Vital_Level0_Attribute := Null_Iir;
Vital_Level1_Attribute := Null_Iir;
@@ -185,11 +185,12 @@ package body Ieee.Vital_Timing is
VitalDelayArrayType01ZX := Null_Iir;
end Extract_Declarations;
- procedure Error_Vital (Msg : String; Loc : Iir) renames Error_Msg_Sem;
- procedure Error_Vital (Msg : String; Loc : Location_Type)
- renames Error_Msg_Sem;
+ procedure Error_Vital (Loc : Location_Type; Msg : String) is
+ begin
+ Error_Msg_Sem (Loc, Msg);
+ end Error_Vital;
- procedure Warning_Vital (Msg : String; Loc : Iir) is
+ procedure Warning_Vital (Loc : Iir; Msg : String) is
begin
Warning_Msg_Sem (Warnid_Vital_Generic, +Loc, Msg);
end Warning_Vital;
@@ -204,8 +205,8 @@ package body Ieee.Vital_Timing is
/= Vital_Level0_Attribute)
then
Error_Vital
- ("first declaration must be the VITAL attribute specification",
- Decl);
+ (+Decl,
+ "first declaration must be the VITAL attribute specification");
return;
end if;
@@ -217,8 +218,8 @@ package body Ieee.Vital_Timing is
or else Get_Named_Entity (Expr) /= Boolean_True
then
Error_Vital
- ("the expression in the VITAL_Level0 attribute specification shall "
- & "be the Boolean literal TRUE", Decl);
+ (+Decl, "the expression in the VITAL_Level0 attribute "
+ & "specification shall be the Boolean literal TRUE");
end if;
-- IEEE 1076.4 4.1
@@ -230,8 +231,8 @@ package body Ieee.Vital_Timing is
| Tok_Architecture =>
null;
when others =>
- Error_Vital ("VITAL attribute specification does not decorate the "
- & "enclosing entity or architecture", Decl);
+ Error_Vital (+Decl, "VITAL attribute specification does not "
+ & "decorate the enclosing entity or architecture");
end case;
end Check_Level0_Attribute_Specification;
@@ -249,13 +250,13 @@ package body Ieee.Vital_Timing is
-- underscore characters.
Image (Get_Identifier (Decl));
if Nam_Buffer (1) = '/' then
- Error_Vital ("VITAL entity port shall not be an extended identifier",
- Decl);
+ Error_Vital
+ (+Decl, "VITAL entity port shall not be an extended identifier");
end if;
for I in 1 .. Nam_Length loop
if Nam_Buffer (I) = '_' then
Error_Vital
- ("VITAL entity port shall not contain underscore", Decl);
+ (+Decl, "VITAL entity port shall not contain underscore");
exit;
end if;
end loop;
@@ -264,7 +265,7 @@ package body Ieee.Vital_Timing is
-- A port that is declared in an entity port declaration shall not be
-- of mode LINKAGE.
if Get_Mode (Decl) = Iir_Linkage_Mode then
- Error_Vital ("VITAL entity port shall not be of mode LINKAGE", Decl);
+ Error_Vital (+Decl, "VITAL entity port shall not be of mode LINKAGE");
end if;
-- IEEE 1076.4 4.3.1
@@ -279,8 +280,8 @@ package body Ieee.Vital_Timing is
if Base_Type = Std_Logic_Vector_Type then
if Get_Resolution_Indication (Atype) /= Null_Iir then
Error_Vital
- ("VITAL array port type cannot override resolution function",
- Decl);
+ (+Decl,
+ "VITAL array port type cannot override resolution function");
end if;
-- FIXME: is an unconstrained array port allowed ?
-- FIXME: what about staticness of the index_constraint ?
@@ -289,16 +290,16 @@ package body Ieee.Vital_Timing is
or else Get_Parent (Type_Decl) /= Std_Logic_1164_Pkg
then
Error_Vital
- ("VITAL entity port type mark shall be one of Std_Logic_1164",
- Decl);
+ (+Decl,
+ "VITAL entity port type mark shall be one of Std_Logic_1164");
end if;
else
- Error_Vital ("VITAL port type must be Std_Logic_Vector or Std_Ulogic",
- Decl);
+ Error_Vital
+ (+Decl, "VITAL port type must be Std_Logic_Vector or Std_Ulogic");
end if;
if Get_Guarded_Signal_Flag (Decl) then
- Error_Vital ("VITAL entity port cannot be guarded", Decl);
+ Error_Vital (+Decl, "VITAL entity port cannot be guarded");
end if;
end Check_Entity_Port_Declaration;
@@ -318,7 +319,7 @@ package body Ieee.Vital_Timing is
Loc : Location_Type;
begin
Loc := Get_Location (Gen_Decl);
- Error_Vital (Str, Loc + Location_Type (Gen_Name_Pos - 1));
+ Error_Vital (Loc + Location_Type (Gen_Name_Pos - 1), Str);
end Error_Vital_Name;
-- Check the next sub-string in the generic name is a port.
@@ -356,9 +357,8 @@ package body Ieee.Vital_Timing is
end if;
end if;
if Res = Null_Iir then
- Warning_Vital ("'" & Nam_Buffer (1 .. Nam_Length)
- & "' is not a port name (in VITAL generic name)",
- Gen_Decl);
+ Warning_Vital (Gen_Decl, "'" & Nam_Buffer (1 .. Nam_Length)
+ & "' is not a port name (in VITAL generic name)");
end if;
return Res;
end Check_Port;
@@ -379,8 +379,8 @@ package body Ieee.Vital_Timing is
| Iir_Inout_Mode =>
null;
when others =>
- Error_Vital ("'" & Nam_Buffer (1 .. Nam_Length)
- & "' must be an input port", Gen_Decl);
+ Error_Vital (+Gen_Decl, "'" & Nam_Buffer (1 .. Nam_Length)
+ & "' must be an input port");
end case;
end if;
return Res;
@@ -403,8 +403,8 @@ package body Ieee.Vital_Timing is
| Iir_Buffer_Mode =>
null;
when others =>
- Error_Vital ("'" & Nam_Buffer (1 .. Nam_Length)
- & "' must be an output port", Gen_Decl);
+ Error_Vital (+Gen_Decl, "'" & Nam_Buffer (1 .. Nam_Length)
+ & "' must be an output port");
end case;
end if;
return Res;
@@ -645,8 +645,8 @@ package body Ieee.Vital_Timing is
when others =>
null;
end case;
- Error_Vital ("type of timing generic is not a VITAL delay type",
- Gen_Decl);
+ Error_Vital (+Gen_Decl,
+ "type of timing generic is not a VITAL delay type");
return Timing_Type_Bad;
end Get_Timing_Generic_Type_Kind;
@@ -691,16 +691,16 @@ package body Ieee.Vital_Timing is
when Timing_Type_Trans_Scalar =>
if Is_Simple then
Error_Vital
- ("VITAL simple scalar timing type expected", Gen_Decl);
+ (+Gen_Decl, "VITAL simple scalar timing type expected");
return;
end if;
when others =>
- Error_Vital ("VITAL scalar timing type expected", Gen_Decl);
+ Error_Vital (+Gen_Decl, "VITAL scalar timing type expected");
return;
end case;
elsif Len >= Port_Length_Unknown then
if Is_Scalar then
- Error_Vital ("VITAL scalar timing type expected", Gen_Decl);
+ Error_Vital (+Gen_Decl, "VITAL scalar timing type expected");
return;
end if;
@@ -710,17 +710,17 @@ package body Ieee.Vital_Timing is
when Timing_Type_Trans_Vector =>
if Is_Simple then
Error_Vital
- ("VITAL simple vector timing type expected", Gen_Decl);
+ (+Gen_Decl, "VITAL simple vector timing type expected");
return;
end if;
when others =>
- Error_Vital ("VITAL vector timing type expected", Gen_Decl);
+ Error_Vital (+Gen_Decl, "VITAL vector timing type expected");
return;
end case;
Len1 := Get_Timing_Generic_Type_Length;
if Len1 /= Len then
- Error_Vital ("length of port and VITAL vector timing subtype "
- & "does not match", Gen_Decl);
+ Error_Vital (+Gen_Decl, "length of port and VITAL vector timing "
+ & "subtype does not match");
end if;
end if;
end Check_Vital_Delay_Type;
@@ -757,16 +757,16 @@ package body Ieee.Vital_Timing is
when Timing_Type_Trans_Scalar =>
if Is_Simple then
Error_Vital
- ("VITAL simple scalar timing type expected", Gen_Decl);
+ (+Gen_Decl, "VITAL simple scalar timing type expected");
return;
end if;
when others =>
- Error_Vital ("VITAL scalar timing type expected", Gen_Decl);
+ Error_Vital (+Gen_Decl, "VITAL scalar timing type expected");
return;
end case;
elsif Len1 >= Port_Length_Unknown or Len2 >= Port_Length_Unknown then
if Is_Scalar then
- Error_Vital ("VITAL scalar timing type expected", Gen_Decl);
+ Error_Vital (+Gen_Decl, "VITAL scalar timing type expected");
return;
end if;
case Kind is
@@ -775,11 +775,11 @@ package body Ieee.Vital_Timing is
when Timing_Type_Trans_Vector =>
if Is_Simple then
Error_Vital
- ("VITAL simple vector timing type expected", Gen_Decl);
+ (+Gen_Decl, "VITAL simple vector timing type expected");
return;
end if;
when others =>
- Error_Vital ("VITAL vector timing type expected", Gen_Decl);
+ Error_Vital (+Gen_Decl, "VITAL vector timing type expected");
return;
end case;
if Len1 = Port_Length_Scalar then
@@ -794,8 +794,8 @@ package body Ieee.Vital_Timing is
end if;
Lenp := Get_Timing_Generic_Type_Length;
if Lenp /= Len1 * Len2 then
- Error_Vital ("length of port and VITAL vector timing subtype "
- & "does not match", Gen_Decl);
+ Error_Vital (+Gen_Decl, "length of port and VITAL vector timing "
+ & "subtype does not match");
end if;
end if;
end Check_Vital_Delay_Type;
@@ -810,7 +810,7 @@ package body Ieee.Vital_Timing is
-- It is an error for a model to use a timing generic prefix to begin
-- the simple name of an entity generic that is not a timing generic.
if Nam_Length < Length or Nam_Buffer (Length) /= '_' then
- Error_Vital ("invalid use of a VITAL timing generic prefix", Decl);
+ Error_Vital (+Decl, "invalid use of a VITAL timing generic prefix");
return False;
end if;
Gen_Name_Pos := Length + 1;
@@ -1067,8 +1067,8 @@ package body Ieee.Vital_Timing is
if Tpd_Decl = Null_Iir then
Error_Vital
- ("no matching 'tpd' generic for VITAL 'tbpd' timing generic",
- Decl);
+ (+Decl,
+ "no matching 'tpd' generic for VITAL 'tbpd' timing generic");
else
-- IEEE 1076.4 4.3.2.1.3.14 Biased propagation delay
-- Furthermore, the type of the biased propagation generic shall
@@ -1076,10 +1076,10 @@ package body Ieee.Vital_Timing is
if not Sem.Are_Trees_Equal (Get_Type (Decl), Get_Type (Tpd_Decl))
then
Error_Vital
- ("type of VITAL 'tbpd' generic mismatch type of "
- & "'tpd' generic", Decl);
+ (+Decl, "type of VITAL 'tbpd' generic mismatch type of "
+ & "'tpd' generic");
Error_Vital
- ("(corresponding 'tpd' timing generic)", Tpd_Decl);
+ (+Tpd_Decl, "(corresponding 'tpd' timing generic)");
end if;
end if;
end;
@@ -1135,8 +1135,9 @@ package body Ieee.Vital_Timing is
if Offset - S = Port'Length
and then Nam_Buffer (S .. Offset - 1) = Port
then
- Error_Vital ("clock port name of 'ticd' VITAL generic must not"
- & " appear here", El);
+ Error_Vital
+ (+El, "clock port name of 'ticd' VITAL generic must not"
+ & " appear here");
end if;
end Check_Not_Clock;
begin
@@ -1244,7 +1245,7 @@ package body Ieee.Vital_Timing is
if Id = InstancePath_Id then
if Get_Base_Type (Get_Type (Decl)) /= String_Type_Definition then
Error_Vital
- ("InstancePath VITAL generic must be of type String", Decl);
+ (+Decl, "InstancePath VITAL generic must be of type String");
end if;
return;
elsif Id = TimingChecksOn_Id
@@ -1253,13 +1254,13 @@ package body Ieee.Vital_Timing is
then
if Get_Type (Decl) /= Boolean_Type_Definition then
Error_Vital
- (Image (Id) & " VITAL generic must be of type Boolean", Decl);
+ (+Decl, Image (Id) & " VITAL generic must be of type Boolean");
end if;
return;
end if;
if Is_Warning_Enabled (Warnid_Vital_Generic) then
- Warning_Vital (Disp_Node (Decl) & " is not a VITAL generic", Decl);
+ Warning_Vital (Decl, Disp_Node (Decl) & " is not a VITAL generic");
end if;
end Check_Entity_Generic_Declaration;
@@ -1280,15 +1281,16 @@ package body Ieee.Vital_Timing is
Check_Level0_Attribute_Specification (Decl);
Decl := Get_Chain (Decl);
if Decl /= Null_Iir then
- Error_Vital ("VITAL entity declarative part must only contain the "
- & "attribute specification", Decl);
+ Error_Vital (+Decl, "VITAL entity declarative part must only contain "
+ & "the attribute specification");
end if;
-- IEEE 1076.4 4.3.1
-- No statements are allowed in the entity statement part.
Decl := Get_Concurrent_Statement_Chain (Ent);
if Decl /= Null_Iir then
- Error_Vital ("VITAL entity must not have concurrent statement", Decl);
+ Error_Vital
+ (+Decl, "VITAL entity must not have concurrent statement");
end if;
-- Check ports.
@@ -1336,8 +1338,8 @@ package body Ieee.Vital_Timing is
-- The entity associated with a Level 0 architecture shall be a VITAL
-- Level 0 entity.
if not Is_Vital_Level0 (Iirs_Utils.Get_Entity (Arch)) then
- Error_Vital ("entity associated with a VITAL level 0 architecture "
- & "shall be a VITAL level 0 entity", Arch);
+ Error_Vital (+Arch, "entity associated with a VITAL level 0 "
+ & "architecture shall be a VITAL level 0 entity");
end if;
-- VITAL_Level_0_architecture_declarative_part ::=
@@ -1359,7 +1361,7 @@ package body Ieee.Vital_Timing is
Check_Vital_Level0_Architecture (Lib_Unit);
when others =>
Error_Vital
- ("only entity or architecture can be VITAL_Level0", Lib_Unit);
+ (+Lib_Unit, "only entity or architecture can be VITAL_Level0");
end case;
end Check_Vital_Level0;
@@ -1369,7 +1371,7 @@ package body Ieee.Vital_Timing is
begin
Arch := Get_Library_Unit (Unit);
if Get_Kind (Arch) /= Iir_Kind_Architecture_Body then
- Error_Vital ("only architecture can be VITAL_Level1", Arch);
+ Error_Vital (+Arch, "only architecture can be VITAL_Level1");
return;
end if;
-- FIXME: todo
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index 92e0f5851..575bf6865 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -5845,7 +5845,7 @@ package body Parse is
if Label /= Null_Identifier then
if Flags.Vhdl_Std = Vhdl_87 then
Error_Msg_Sem
- ("this statement can't have a label in vhdl 87", Stmt);
+ (+Stmt, "this statement can't have a label in vhdl 87");
else
Set_Label (Stmt, Label);
end if;
@@ -8147,8 +8147,9 @@ package body Parse is
-- unit that is a context declaration is not empty.
if Get_Context_Items (Unit) /= Null_Iir then
Error_Msg_Sem
- ("context declaration does not allow context "
- & "clauses before it", Get_Context_Items (Unit));
+ (+Get_Context_Items (Unit),
+ "context declaration does not allow context "
+ & "clauses before it");
end if;
return;
diff --git a/src/vhdl/psl-errors.ads b/src/vhdl/psl-errors.ads
index c172ab80b..88239a844 100644
--- a/src/vhdl/psl-errors.ads
+++ b/src/vhdl/psl-errors.ads
@@ -12,5 +12,5 @@ package PSL.Errors is
procedure Error_Msg_Parse (Msg: String)
renames Errorout.Error_Msg_Parse_1;
procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node)
- renames Errorout.Error_Msg_Sem;
+ renames Errorout.Error_Msg_Sem_1;
end PSL.Errors;
diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index 6cb547ec2..9e4540308 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -20,7 +20,6 @@ with Errorout; use Errorout;
with Std_Package; use Std_Package;
with Ieee.Std_Logic_1164;
with Libraries;
-with Files_Map;
with Std_Names;
with Sem_Scopes; use Sem_Scopes;
with Sem_Expr; use Sem_Expr;
@@ -31,7 +30,6 @@ with Sem_Assocs; use Sem_Assocs;
with Sem_Inst;
with Iirs_Utils; use Iirs_Utils;
with Flags; use Flags;
-with Name_Table;
with Str_Table;
with Sem_Stmts; use Sem_Stmts;
with Iir_Chains;
@@ -114,8 +112,7 @@ package body Sem is
Entity := Libraries.Load_Primary_Unit
(Library, Get_Identifier (Name), Library_Unit);
if Entity = Null_Iir then
- Error_Msg_Sem ("entity " & Disp_Node (Name) & " was not analysed",
- Library_Unit);
+ Error_Msg_Sem (+Library_Unit, "entity %n was not analysed", +Name);
return Null_Iir;
end if;
Entity := Get_Library_Unit (Entity);
@@ -144,8 +141,7 @@ package body Sem is
if Get_Library (Get_Design_File (Get_Design_Unit (Entity))) /= Library
then
Error_Msg_Sem
- (Disp_Node (Entity) & " does not reside in "
- & Disp_Node (Library), Library_Unit);
+ (+Library_Unit, "%n does not reside in %n", (+Entity, +Library));
return Null_Iir;
end if;
@@ -555,7 +551,7 @@ package body Sem is
Set_Collapse_Signal_Flag
(El, Can_Collapse_Signals (El, Formal));
if Get_Name_Staticness (Object) < Globally then
- Error_Msg_Sem ("actual must be a static name", Actual);
+ Error_Msg_Sem (+Actual, "actual must be a static name");
end if;
if Get_Kind (Prefix) = Iir_Kind_Interface_Signal_Declaration
then
@@ -592,8 +588,9 @@ package body Sem is
-- with constant driving values; such ports must be
-- of mode in.
if Get_Mode (Formal_Base) /= Iir_In_Mode then
- Error_Msg_Sem ("only 'in' ports may be associated "
- & "with expression", El);
+ Error_Msg_Sem
+ (+El, "only 'in' ports may be associated with "
+ & "expression");
end if;
-- LRM93 1.1.1.2 Ports
@@ -601,13 +598,13 @@ package body Sem is
-- static expression.
if Get_Expr_Staticness (Actual) < Globally then
Error_Msg_Sem
- ("actual expression must be globally static",
- Actual);
+ (+Actual,
+ "actual expression must be globally static");
end if;
else
Error_Msg_Sem
- ("cannot associate ports with expression in vhdl87",
- El);
+ (+El,
+ "cannot associate ports with expression in vhdl87");
end if;
end case;
end if;
@@ -698,7 +695,7 @@ package body Sem is
| Iir_Kind_Slice_Name =>
Block_Name := Get_Prefix (Block_Spec);
when others =>
- Error_Msg_Sem ("label expected", Block_Spec);
+ Error_Msg_Sem (+Block_Spec, "label expected");
return Null_Iir;
end case;
@@ -708,8 +705,8 @@ package body Sem is
case Get_Kind (Block) is
when Iir_Kind_Block_Statement =>
if Get_Kind (Block_Spec) /= Iir_Kind_Simple_Name then
- Error_Msg_Sem ("label does not denote a generate statement",
- Block_Spec);
+ Error_Msg_Sem (+Block_Spec,
+ "label does not denote a generate statement");
end if;
Set_Block_Specification (Block_Conf, Block_Name);
Prev := Get_Block_Block_Configuration (Block);
@@ -758,16 +755,17 @@ package body Sem is
-- specification that is an alternative label.
if Get_Has_Label (Res) then
Error_Msg_Sem
- ("alternative label required in block specification",
- Block_Spec);
+ (+Block_Spec,
+ "alternative label required in block specification");
end if;
Set_Block_Specification (Block_Conf, Block_Name);
when Iir_Kind_Parenthesis_Name =>
if Vhdl_Std < Vhdl_08 then
- Error_Msg_Sem ("alternative label only allowed by vhdl08",
- Block_Spec);
+ Error_Msg_Sem
+ (+Block_Spec,
+ "alternative label only allowed by vhdl08");
return Null_Iir;
end if;
Assoc := Get_Association_Chain (Block_Spec);
@@ -777,8 +775,8 @@ package body Sem is
Gen_Spec := Get_Actual (Assoc);
if Get_Kind (Gen_Spec) /= Iir_Kind_Simple_Name then
Error_Msg_Sem
- ("alternative label expected for if-generate",
- Gen_Spec);
+ (+Gen_Spec,
+ "alternative label expected for if-generate");
return Null_Iir;
end if;
-- Search label.
@@ -791,8 +789,9 @@ package body Sem is
end loop;
if Clause = Null_Iir then
Error_Msg_Sem
- ("alternative label " & Image_Identifier (Gen_Spec)
- & " not found for if-generate", Gen_Spec);
+ (+Gen_Spec,
+ "alternative label %i not found for if-generate",
+ +Gen_Spec);
return Null_Iir;
end if;
Set_Named_Entity (Block_Spec, Res);
@@ -815,8 +814,8 @@ package body Sem is
-- configuration, [...]
-- GHDL: doesn't apply to case generate statement
Error_Msg_Sem
- ("missing alternative label for a case-generate",
- Block_Spec);
+ (+Block_Spec,
+ "missing alternative label for a case-generate");
return Null_Iir;
when Iir_Kind_Parenthesis_Name =>
Assoc := Get_Association_Chain (Block_Spec);
@@ -826,8 +825,8 @@ package body Sem is
Gen_Spec := Get_Actual (Assoc);
if Get_Kind (Gen_Spec) /= Iir_Kind_Simple_Name then
Error_Msg_Sem
- ("alternative label expected for case-generate",
- Gen_Spec);
+ (+Gen_Spec,
+ "alternative label expected for case-generate");
return Null_Iir;
end if;
-- Search label.
@@ -840,8 +839,9 @@ package body Sem is
end loop;
if Clause = Null_Iir then
Error_Msg_Sem
- ("alternative label " & Image_Identifier (Gen_Spec)
- & " not found for case-generate", Gen_Spec);
+ (+Gen_Spec,
+ "alternative label %i not found for case-generate",
+ +Gen_Spec);
return Null_Iir;
end if;
Set_Named_Entity (Block_Spec, Res);
@@ -857,8 +857,8 @@ package body Sem is
Prev := Get_Generate_Block_Configuration (Res);
when others =>
- Error_Msg_Sem ("block or generate statement label expected",
- Block_Conf);
+ Error_Msg_Sem (+Block_Conf,
+ "block or generate statement label expected");
return Null_Iir;
end case;
@@ -870,8 +870,8 @@ package body Sem is
(Get_Block_From_Block_Specification
(Get_Block_Specification (Father)));
if not Is_In_Chain (Block_Stmts, Block) then
- Error_Msg_Sem ("label does not denotes an inner block statement",
- Block_Conf);
+ Error_Msg_Sem (+Block_Conf,
+ "label does not denotes an inner block statement");
return Null_Iir;
end if;
@@ -882,8 +882,9 @@ package body Sem is
-- one configuration item is defined for the same block [or
-- component instance].
if Prev /= Null_Iir then
- Error_Msg_Sem (Disp_Node (Block) & " was already configured at "
- & Disp_Location (Prev), Block_Conf);
+ Error_Msg_Sem
+ (+Block_Conf,
+ "%n was already configured at %l", (+Block, +Prev));
return Null_Iir;
end if;
Set_Block_Block_Configuration (Res, Block_Conf);
@@ -895,8 +896,9 @@ package body Sem is
-- one configuration item is defined for the same block [or
-- component instance].
if Prev /= Null_Iir then
- Error_Msg_Sem (Disp_Node (Block) & " was already configured at "
- & Disp_Location (Prev), Block_Conf);
+ Error_Msg_Sem
+ (+Block_Conf,
+ "%n was already configured at %l", (+Block, +Prev));
return Null_Iir;
end if;
Set_Generate_Block_Configuration (Res, Block_Conf);
@@ -945,7 +947,7 @@ package body Sem is
Block_Spec := Get_Block_Specification (Block_Conf);
-- FIXME: handle selected name.
if Get_Kind (Block_Spec) /= Iir_Kind_Simple_Name then
- Error_Msg_Sem ("architecture name expected", Block_Spec);
+ Error_Msg_Sem (+Block_Spec, "architecture name expected");
return;
end if;
-- LRM 10.3 rule b)
@@ -959,8 +961,7 @@ package body Sem is
Block_Conf);
if Design = Null_Iir then
Error_Msg_Sem
- ("no architecture '" & Image_Identifier (Block_Spec) & "'",
- Block_Conf);
+ (+Block_Conf, "no architecture %i", +Block_Spec);
return;
end if;
Arch := Get_Library_Unit (Design);
@@ -991,14 +992,14 @@ package body Sem is
if Entity_Aspect = Null_Iir or else
Get_Kind (Entity_Aspect) /= Iir_Kind_Entity_Aspect_Entity
then
- Error_Msg_Sem ("corresponding component not fully bound",
- Block_Conf);
+ Error_Msg_Sem
+ (+Block_Conf, "corresponding component not fully bound");
end if;
Block_Spec := Get_Block_Specification (Block_Conf);
-- FIXME: handle selected name.
if Get_Kind (Block_Spec) /= Iir_Kind_Simple_Name then
- Error_Msg_Sem ("architecture name expected", Block_Spec);
+ Error_Msg_Sem (+Block_Spec, "architecture name expected");
return;
end if;
@@ -1010,8 +1011,8 @@ package body Sem is
if Get_Identifier (Comp_Arch) /= Get_Identifier (Block_Spec)
then
Error_Msg_Sem
- ("block specification name is different from "
- & "component architecture name", Block_Spec);
+ (+Block_Spec, "block specification name is different "
+ & "from component architecture name");
return;
end if;
end if;
@@ -1027,8 +1028,7 @@ package body Sem is
Block_Conf);
if Design = Null_Iir then
Error_Msg_Sem
- ("no architecture '" & Image_Identifier (Block_Spec) & "'",
- Block_Conf);
+ (+Block_Conf, "no architecture %i", +Block_Spec);
return;
end if;
Arch := Get_Library_Unit (Design);
@@ -1208,9 +1208,9 @@ package body Sem is
/= Iir_Kind_Association_Element_Open
then
Error_Msg_Sem
- (Disp_Node (Formal)
- & " already associated in primary binding",
- S_El);
+ (+S_El,
+ "%n already associated in primary binding",
+ +Formal);
end if;
S_El := Get_Chain (S_El);
end loop;
@@ -1603,9 +1603,9 @@ package body Sem is
begin
if not Are_Trees_Equal (Subprg, Spec) then
-- FIXME: should explain why it does not conform ?
- Error_Msg_Sem ("body of " & Disp_Node (Subprg)
- & " does not conform with specification at "
- & Disp_Location (Spec), Subprg);
+ Error_Msg_Sem
+ (+Subprg, "body of %n does not conform with specification at %l",
+ (+Subprg, +Spec));
end if;
end Check_Conformance_Rules;
@@ -1738,8 +1738,8 @@ package body Sem is
if Nbr_Interfaces = 1 then
return;
end if;
- Error_Msg_Sem ("unary operator must have a single parameter",
- Subprg);
+ Error_Msg_Sem
+ (+Subprg, "unary operator must have a single parameter");
when Name_Mod
| Name_Rem
| Name_Op_Mul
@@ -1760,7 +1760,7 @@ package body Sem is
return;
end if;
Error_Msg_Sem
- ("binary operators must have two parameters", Subprg);
+ (+Subprg, "binary operators must have two parameters");
when Name_Logical_Operators
| Name_Xnor =>
-- LRM08 4.5.2 Operator overloading
@@ -1775,11 +1775,11 @@ package body Sem is
return;
end if;
Error_Msg_Sem
- ("logical operators must have two parameters before vhdl08",
- Subprg);
+ (+Subprg,
+ "logical operators must have two parameters before vhdl08");
else
Error_Msg_Sem
- ("logical operators must have two parameters", Subprg);
+ (+Subprg, "logical operators must have two parameters");
end if;
when Name_Op_Plus
| Name_Op_Minus =>
@@ -1790,15 +1790,15 @@ package body Sem is
return;
end if;
Error_Msg_Sem
- ("""+"" and ""-"" operators must have 1 or 2 parameters",
- Subprg);
+ (+Subprg,
+ """+"" and ""-"" operators must have 1 or 2 parameters");
when others =>
return;
end case;
if Is_Method then
Error_Msg_Sem
- (" (the protected object is an implicit parameter of methods)",
- Subprg);
+ (+Subprg,
+ " (the protected object is an implicit parameter of methods)");
end if;
end Check_Operator_Requirements;
@@ -1896,10 +1896,10 @@ package body Sem is
case Get_Kind (Return_Type) is
when Iir_Kind_File_Type_Definition =>
Error_Msg_Sem
- ("result subtype cannot denote a file type", Subprg);
+ (+Subprg, "result subtype cannot denote a file type");
when Iir_Kind_Protected_Type_Declaration =>
Error_Msg_Sem
- ("result subtype cannot denote a protected type", Subprg);
+ (+Subprg, "result subtype cannot denote a protected type");
when Iir_Kind_Access_Type_Definition
| Iir_Kind_Access_Subtype_Definition =>
if Vhdl_Std >= Vhdl_08
@@ -1978,10 +1978,8 @@ package body Sem is
if Spec /= Null_Iir then
-- SUBPRG is the body of the specification SPEC.
if Get_Subprogram_Body (Spec) /= Null_Iir then
- Error_Msg_Sem
- (Disp_Node (Spec) & " body already defined at "
- & Files_Map.Image (Get_Location (Get_Subprogram_Body (Spec))),
- Subprg);
+ Error_Msg_Sem (+Subprg, "%n body already defined at %l",
+ (+Spec, +Get_Subprogram_Body (Spec)));
-- Kill warning.
Set_Use_Flag (Subprg, True);
else
@@ -2048,7 +2046,7 @@ package body Sem is
then
-- Incoherence: procedures declared in std library are not
-- expected to suspend. This is an internal check.
- Error_Msg_Sem ("unexpected suspendable procedure", Subprg);
+ Error_Msg_Sem (+Subprg, "unexpected suspendable procedure");
end if;
-- Update purity state of procedure if there are no callees.
@@ -2147,11 +2145,10 @@ package body Sem is
procedure Error_Wait (Caller : Iir; Callee : Iir) is
begin
Error_Msg_Sem
- (Disp_Node (Caller) & " must not contain wait statement, but calls",
- Caller);
+ (+Caller, "%n must not contain wait statement, but calls",
+ (1 => +Caller), Cont => True);
Error_Msg_Sem
- (Disp_Node (Callee) & " which has (indirectly) a wait statement",
- Callee);
+ (+Callee, "%n which has (indirectly) a wait statement", +Callee);
end Error_Wait;
-- Kind of subprg.
@@ -2342,11 +2339,11 @@ package body Sem is
-- parameter or member of a formal parameter of
-- the subprogram or of any of its parents.
Error_Msg_Sem
- ("all-sensitized " & Disp_Node (Subprg)
- & " can't call " & Disp_Node (Callee), Subprg);
+ (+Subprg, "all-sensitized %n can't call %n",
+ (+Subprg, +Callee), Cont => True);
Error_Msg_Sem
- (" (as this subprogram reads (indirectly) a signal)",
- Subprg);
+ (+Subprg,
+ " (as this subprogram reads (indirectly) a signal)");
end case;
end if;
@@ -2620,16 +2617,13 @@ package body Sem is
(Get_Library (Get_Design_File (Get_Current_Design_Unit)),
Package_Ident, Decl);
if Design_Unit = Null_Iir then
- Error_Msg_Sem ("package '" & Name_Table.Image (Package_Ident)
- & "' was not analysed",
- Decl);
+ Error_Msg_Sem (+Decl, "package %i was not analysed", +Package_Ident);
return;
end if;
Package_Decl := Get_Library_Unit (Design_Unit);
if Get_Kind (Package_Decl) /= Iir_Kind_Package_Declaration then
Error_Msg_Sem
- ("primary unit '" & Name_Table.Image (Package_Ident)
- & "' is not a package", Decl);
+ (+Decl, "primary unit %i is not a package", +Package_Ident);
return;
end if;
@@ -2678,8 +2672,7 @@ package body Sem is
-- What could be done ?
return Null_Iir;
elsif not Is_Uninstantiated_Package (Pkg) then
- Error_Msg_Sem
- (Disp_Node (Pkg) & " is not an uninstantiated package", Name);
+ Error_Msg_Sem (+Name, "%n is not an uninstantiated package", +Pkg);
-- What could be done ?
return Null_Iir;
@@ -2758,7 +2751,7 @@ package body Sem is
| Iir_Kind_Selected_Name =>
Name_Prefix := Get_Prefix (Name);
when others =>
- Error_Msg_Sem ("use clause allows only selected name", Name);
+ Error_Msg_Sem (+Name, "use clause allows only selected name");
return;
end case;
@@ -2794,13 +2787,13 @@ package body Sem is
-- clause denotes an uninstantiated package.
if Is_Uninstantiated_Package (Prefix) then
Error_Msg_Sem
- ("use of uninstantiated package is not allowed",
- Name_Prefix);
+ (+Name_Prefix,
+ "use of uninstantiated package is not allowed");
return;
end if;
when others =>
Error_Msg_Sem
- ("prefix must designate a package or a library", Prefix);
+ (+Prefix, "prefix must designate a package or a library");
return;
end case;
@@ -2846,8 +2839,7 @@ package body Sem is
Ident := Get_Identifier (Decl);
Lib := Libraries.Get_Library (Ident, Get_Location (Decl));
if Lib = Null_Iir then
- Error_Msg_Sem
- ("no resource library """ & Name_Table.Image (Ident) & """", Decl);
+ Error_Msg_Sem (+Decl, "no resource library %i", +Ident);
else
Set_Library_Declaration (Decl, Lib);
Sem_Scopes.Add_Name (Lib, Ident, False);
@@ -2865,7 +2857,7 @@ package body Sem is
Name := Get_Selected_Name (Ref);
if Get_Kind (Name) /= Iir_Kind_Selected_Name then
Error_Msg_Sem
- ("context reference only allows selected names", Name);
+ (+Name, "context reference only allows selected names");
return;
end if;
@@ -2880,7 +2872,7 @@ package body Sem is
-- It is an error if a selected name in a context reference does not
-- denote a context declaration.
if Get_Kind (Ent) /= Iir_Kind_Context_Declaration then
- Error_Msg_Sem ("name must denote a context declaration", Name);
+ Error_Msg_Sem (+Name, "name must denote a context declaration");
Set_Named_Entity (Name, Null_Iir);
return;
end if;
@@ -2946,7 +2938,7 @@ package body Sem is
procedure Error_Work_Prefix (Loc : Iir) is
begin
Error_Msg_Sem
- ("'work' not allowed as prefix in context declaration", Loc);
+ (+Loc, "'work' not allowed as prefix in context declaration");
end Error_Work_Prefix;
El : Iir;
@@ -2966,7 +2958,7 @@ package body Sem is
-- defines the library logical name WORK, [...]
if Get_Identifier (El) = Std_Names.Name_Work then
Error_Msg_Sem
- ("'library work' not allowed in context declaration", El);
+ (+El, "'library work' not allowed in context declaration");
end if;
when Iir_Kind_Use_Clause =>
-- LRM08 13.3 Context declarations
diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb
index b17a71f93..10d4f7896 100644
--- a/src/vhdl/sem_assocs.adb
+++ b/src/vhdl/sem_assocs.adb
@@ -140,7 +140,7 @@ package body Sem_Assocs is
-- FIXME: check FORMAL is well composed.
elsif Has_Named then
-- FIXME: do the check in parser.
- Error_Msg_Sem ("positional argument after named argument", Assoc);
+ Error_Msg_Sem (+Assoc, "positional argument after named argument");
Ok := False;
end if;
if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression then
@@ -178,9 +178,9 @@ package body Sem_Assocs is
Error_Kind ("check_parameter_association_restriction", Inter);
end case;
Error_Msg_Sem
- ("cannot associate an " & Get_Mode_Name (Get_Mode (Base_Actual))
- & " object with " & Get_Mode_Name (Get_Mode (Inter)) & " "
- & Disp_Node (Inter), Loc);
+ (+Loc, "cannot associate an " & Get_Mode_Name (Get_Mode (Base_Actual))
+ & " object with " & Get_Mode_Name (Get_Mode (Inter)) & " %n",
+ +Inter);
end Check_Parameter_Association_Restriction;
procedure Check_Subprogram_Associations
@@ -211,7 +211,7 @@ package body Sem_Assocs is
when Iir_Kind_Association_Element_Open =>
if Get_Default_Value (Formal_Inter) = Null_Iir then
Error_Msg_Sem
- ("no parameter for " & Disp_Node (Formal_Inter), Assoc);
+ (+Assoc, "no parameter for %n", +Formal_Inter);
end if;
when Iir_Kind_Association_Element_By_Expression =>
Actual := Get_Actual (Assoc);
@@ -239,8 +239,8 @@ package body Sem_Assocs is
-- must be denoted by a static signal name.
if Get_Name_Staticness (Object) < Globally then
Error_Msg_Sem
- ("actual signal must be a static name",
- Actual);
+ (+Actual,
+ "actual signal must be a static name");
else
-- Inherit has_active_flag.
Set_Has_Active_Flag
@@ -248,8 +248,8 @@ package body Sem_Assocs is
end if;
when others =>
Error_Msg_Sem
- ("signal parameter requires a signal expression",
- Assoc);
+ (+Assoc,
+ "signal parameter requires a signal expression");
end case;
case Get_Kind (Prefix) is
@@ -259,16 +259,18 @@ package body Sem_Assocs is
when Iir_Kind_Guard_Signal_Declaration =>
if Get_Mode (Formal_Inter) /= Iir_In_Mode then
Error_Msg_Sem
- ("cannot associate a guard signal with "
+ (+Assoc,
+ "cannot associate a guard signal with "
& Get_Mode_Name (Get_Mode (Formal_Inter))
- & " " & Disp_Node (Formal_Inter), Assoc);
+ & " %n", +Formal_Inter);
end if;
when Iir_Kinds_Signal_Attribute =>
if Get_Mode (Formal_Inter) /= Iir_In_Mode then
Error_Msg_Sem
- ("cannot associate a signal attribute with "
+ (+Assoc,
+ "cannot associate a signal attribute with "
& Get_Mode_Name (Get_Mode (Formal_Inter))
- & " " & Disp_Node (Formal_Inter), Assoc);
+ & " %n", +Formal_Inter);
end if;
when others =>
null;
@@ -282,8 +284,9 @@ package body Sem_Assocs is
if Get_In_Conversion (Assoc) /= Null_Iir
or Get_Out_Conversion (Assoc) /= Null_Iir
then
- Error_Msg_Sem ("conversion are not allowed for "
- & "signal parameters", Assoc);
+ Error_Msg_Sem
+ (+Assoc,
+ "conversion are not allowed for signal parameters");
end if;
when Iir_Kind_Interface_Variable_Declaration =>
-- LRM93 2.1.1
@@ -303,12 +306,13 @@ package body Sem_Assocs is
-- Such an object is a member of the variable
-- class of objects;
if Flags.Vhdl_Std >= Vhdl_93 then
- Error_Msg_Sem ("in vhdl93, variable parameter "
- & "cannot be a file", Assoc);
+ Error_Msg_Sem
+ (+Assoc, "variable parameter cannot be a "
+ & "file (vhdl93)");
end if;
when others =>
Error_Msg_Sem
- ("variable parameter must be a variable", Assoc);
+ (+Assoc, "variable parameter must be a variable");
end case;
when Iir_Kind_Interface_File_Declaration =>
-- LRM93 2.1.1
@@ -321,12 +325,12 @@ package body Sem_Assocs is
when Iir_Kind_Variable_Declaration
| Iir_Kind_Interface_Variable_Declaration =>
if Flags.Vhdl_Std >= Vhdl_93 then
- Error_Msg_Sem ("in vhdl93, file parameter "
- & "must be a file", Assoc);
+ Error_Msg_Sem (+Assoc, "file parameter "
+ & "must be a file (vhdl93)");
end if;
when others =>
Error_Msg_Sem
- ("file parameter must be a file", Assoc);
+ (+Assoc, "file parameter must be a file");
end case;
-- LRM 2.1.1.3 File parameters
@@ -337,8 +341,8 @@ package body Sem_Assocs is
if Get_In_Conversion (Assoc) /= Null_Iir
or Get_Out_Conversion (Assoc) /= Null_Iir
then
- Error_Msg_Sem ("conversion are not allowed for "
- & "file parameters", Assoc);
+ Error_Msg_Sem (+Assoc, "conversion are not allowed "
+ & "for file parameters");
end if;
when Iir_Kind_Interface_Constant_Declaration =>
-- LRM93 2.1.1
@@ -412,9 +416,9 @@ package body Sem_Assocs is
if Assoc /= Null_Iir then
Error_Msg_Sem
- ("cannot associate " & Get_Mode_Name (Fmode) & " "
- & Disp_Node (Formal) & " with actual port of mode "
- & Get_Mode_Name (Amode), Assoc);
+ (+Assoc, "cannot associate " & Get_Mode_Name (Fmode) & " %n"
+ & " with actual port of mode "
+ & Get_Mode_Name (Amode), +Formal);
end if;
return False;
end Check_Port_Association_Restriction;
@@ -447,7 +451,7 @@ package body Sem_Assocs is
Index := Eval_Expr (Index);
Replace_Nth_Element (Index_List, I, Index);
else
- Error_Msg_Sem ("index expression must be locally static", Index);
+ Error_Msg_Sem (+Index, "index expression must be locally static");
Set_Choice_Staticness (Base_Assoc, None);
end if;
@@ -527,7 +531,7 @@ package body Sem_Assocs is
Index := Eval_Range (Index);
Set_Suffix (Formal, Index);
else
- Error_Msg_Sem ("range expression must be locally static", Index);
+ Error_Msg_Sem (+Index, "range expression must be locally static");
Set_Choice_Staticness (Sub_Assoc, None);
end if;
@@ -594,10 +598,9 @@ package body Sem_Assocs is
Iassoc := Sub;
when others =>
Error_Msg_Sem
- ("individual association of "
- & Disp_Node (Get_Association_Interface (Iassoc))
- & " conflicts with that at " & Disp_Location (Sub),
- Formal);
+ (+Formal, "individual association of %n"
+ & " conflicts with that at %l",
+ (+Get_Association_Interface (Iassoc), +Sub));
return;
end case;
end if;
@@ -636,10 +639,9 @@ package body Sem_Assocs is
Prev := Get_Associated_Expr (Res_Iass);
if Prev /= Null_Iir then
- Error_Msg_Sem ("individual association of "
- & Disp_Node (Get_Association_Interface (Assoc))
- & " conflicts with that at " & Disp_Location (Prev),
- Assoc);
+ Error_Msg_Sem
+ (+Assoc, "individual association of %n conflicts with that at %l",
+ (+Get_Association_Interface (Assoc), +Prev));
else
Set_Associated_Expr (Res_Iass, Assoc);
end if;
@@ -742,8 +744,8 @@ package body Sem_Assocs is
if Eval_Pos (Act_Low) /= Eval_Pos (Low)
or Eval_Pos (Act_High) /= Eval_Pos (High)
then
- Error_Msg_Sem ("indexes of individual association mismatch",
- Assoc);
+ Error_Msg_Sem
+ (+Assoc, "indexes of individual association mismatch");
end if;
end;
end if;
@@ -764,9 +766,8 @@ package body Sem_Assocs is
Rec_El := Get_Choice_Name (Ch);
Pos := Natural (Get_Element_Position (Rec_El));
if Matches (Pos) /= Null_Iir then
- Error_Msg_Sem ("individual " & Disp_Node (Rec_El)
- & " already associated at "
- & Disp_Location (Matches (Pos)), Ch);
+ Error_Msg_Sem (+Ch, "individual %n already associated at %l",
+ (+Rec_El, +Matches (Pos)));
else
Matches (Pos) := Ch;
end if;
@@ -775,7 +776,7 @@ package body Sem_Assocs is
for I in Matches'Range loop
Rec_El := Get_Nth_Element (El_List, I);
if Matches (I) = Null_Iir then
- Error_Msg_Sem (Disp_Node (Rec_El) & " not associated", Assoc);
+ Error_Msg_Sem (+Assoc, "%n not associated", +Rec_El);
end if;
end loop;
Set_Actual_Type (Assoc, Atype);
@@ -1227,7 +1228,7 @@ package body Sem_Assocs is
Res := Conv;
else
Res := Null_Iir;
- Error_Msg_Sem ("conversion function or type does not match", Loc);
+ Error_Msg_Sem (+Loc, "conversion function or type does not match");
end if;
end if;
return Res;
@@ -1330,8 +1331,8 @@ package body Sem_Assocs is
-- It is an error if an actual of open is associated with a
-- formal that is associated individually.
if Assoc_Kind = Individual then
- Error_Msg_Sem ("cannot associate individually with open",
- Assoc);
+ Error_Msg_Sem
+ (+Assoc, "cannot associate individually with open");
end if;
end if;
else
@@ -1389,7 +1390,7 @@ package body Sem_Assocs is
-- package declaration [...]
if Get_Kind (Actual) /= Iir_Kind_Package_Instantiation_Declaration then
Error_Msg_Sem
- ("actual of association is not a package instantiation", Assoc);
+ (+Assoc, "actual of association is not a package instantiation");
return;
end if;
@@ -1399,8 +1400,8 @@ package body Sem_Assocs is
/= Package_Inter
then
Error_Msg_Sem
- ("actual package name is not an instance of interface package",
- Assoc);
+ (+Assoc,
+ "actual package name is not an instance of interface package");
return;
end if;
@@ -1499,15 +1500,13 @@ package body Sem_Assocs is
if Match = Not_Compatible then
if Finish then
+ Error_Msg_Sem (+Assoc, "can't associate %n with %n",
+ (+Actual, +Inter), Cont => True);
Error_Msg_Sem
- ("can't associate " & Disp_Node (Actual) & " with "
- & Disp_Node (Inter), Assoc);
- Error_Msg_Sem
- ("(type of " & Disp_Node (Actual) & " is "
- & Disp_Type_Of (Actual) & ")", Assoc);
+ (+Assoc, "(type of %n is " & Disp_Type_Of (Actual) & ")",
+ (1 => +Actual), Cont => True);
Error_Msg_Sem
- ("(type of " & Disp_Node (Inter) & " is "
- & Disp_Type_Of (Inter) & ")", Inter);
+ (+Inter, "(type of %n is " & Disp_Type_Of (Inter) & ")", +Inter);
end if;
return;
end if;
@@ -1568,7 +1567,7 @@ package body Sem_Assocs is
and then Get_Mode (Inter) = Iir_In_Mode
then
Error_Msg_Sem
- ("can't use an out conversion for an in interface", Assoc);
+ (+Assoc, "can't use an out conversion for an in interface");
end if;
-- LRM08 6.5.7 Association lists
@@ -1580,7 +1579,7 @@ package body Sem_Assocs is
and then Get_Mode (Inter) in Iir_Buffer_Mode .. Iir_Out_Mode
then
Error_Msg_Sem
- ("can't use an in conversion for an out/buffer interface", Assoc);
+ (+Assoc, "can't use an in conversion for an out/buffer interface");
end if;
-- LRM08 5.3.2.2 Index constraints and discrete ranges
@@ -1605,7 +1604,7 @@ package body Sem_Assocs is
and then not Is_Fully_Constrained_Type (Get_Type (In_Conv))
then
Error_Msg_Sem
- ("type of actual conversion must be fully constrained", Assoc);
+ (+Assoc, "type of actual conversion must be fully constrained");
end if;
if (Get_Mode (Inter) in Iir_Out_Modes
or else Get_Mode (Inter) = Iir_Linkage_Mode)
@@ -1613,7 +1612,7 @@ package body Sem_Assocs is
and then not Is_Fully_Constrained_Type (Get_Type (Out_Conv))
then
Error_Msg_Sem
- ("type of formal conversion must be fully constrained", Assoc);
+ (+Assoc, "type of formal conversion must be fully constrained");
end if;
end if;
@@ -1623,10 +1622,10 @@ package body Sem_Assocs is
if Get_Mode (Inter) = Iir_Inout_Mode then
if In_Conv = Null_Iir and then Out_Conv /= Null_Iir then
Error_Msg_Sem
- ("out conversion without corresponding in conversion", Assoc);
+ (+Assoc, "out conversion without corresponding in conversion");
elsif In_Conv /= Null_Iir and then Out_Conv = Null_Iir then
Error_Msg_Sem
- ("in conversion without corresponding out conversion", Assoc);
+ (+Assoc, "in conversion without corresponding out conversion");
end if;
end if;
Set_Actual (Assoc, Actual);
@@ -1638,8 +1637,8 @@ package body Sem_Assocs is
Set_Actual (Assoc, Expr);
if In_Conv = Null_Iir and then Out_Conv = Null_Iir then
if not Check_Implicit_Conversion (Formal_Type, Expr) then
- Error_Msg_Sem ("actual length does not match formal length",
- Assoc);
+ Error_Msg_Sem
+ (+Assoc, "actual length does not match formal length");
end if;
end if;
end if;
@@ -1737,8 +1736,7 @@ package body Sem_Assocs is
-- Try to match actual of ASSOC with the interface.
if Inter = Null_Iir then
if Finish then
- Error_Msg_Sem
- ("too many actuals for " & Disp_Node (Loc), Assoc);
+ Error_Msg_Sem (+Assoc, "too many actuals for %n", +Loc);
end if;
Match := Not_Compatible;
return;
@@ -1813,7 +1811,7 @@ package body Sem_Assocs is
else
if Finish then
Error_Msg_Sem
- (Disp_Node (Inter) & " already associated", Assoc);
+ (+Assoc, "%n already associated", +Inter);
end if;
Match := Not_Compatible;
return;
@@ -1827,8 +1825,9 @@ package body Sem_Assocs is
and then Last_Individual /= Inter
then
Error_Msg_Sem
- ("non consecutive individual association for "
- & Disp_Node (Inter), Assoc);
+ (+Assoc,
+ "non consecutive individual association for %n",
+ +Inter);
Match := Not_Compatible;
return;
end if;
@@ -1837,7 +1836,7 @@ package body Sem_Assocs is
else
if Finish then
Error_Msg_Sem
- (Disp_Node (Inter) & " already associated", Assoc);
+ (+Assoc, "%n already associated", +Inter);
Match := Not_Compatible;
return;
end if;
@@ -1852,9 +1851,8 @@ package body Sem_Assocs is
if Finish then
-- FIXME: display the name of subprg or component/entity.
-- FIXME: fetch the interface (for parenthesis_name).
- Error_Msg_Sem
- ("no interface for " & Disp_Node (Get_Formal (Assoc))
- & " in association", Assoc);
+ Error_Msg_Sem (+Assoc, "no interface for %n in association",
+ +Get_Formal (Assoc));
end if;
Match := Not_Compatible;
return;
@@ -1909,8 +1907,7 @@ package body Sem_Assocs is
when Missing_Parameter
| Missing_Generic =>
if Finish then
- Error_Msg_Sem
- ("no actual for " & Disp_Node (Inter), Loc);
+ Error_Msg_Sem (+Loc, "no actual for %n", +Inter);
end if;
Match := Not_Compatible;
return;
@@ -1921,8 +1918,8 @@ package body Sem_Assocs is
raise Internal_Error;
end if;
Error_Msg_Sem
- (Disp_Node (Inter)
- & " of mode IN must be connected", Loc);
+ (+Loc,
+ "%n of mode IN must be connected", +Inter);
Match := Not_Compatible;
return;
when Iir_Out_Mode
@@ -1936,8 +1933,9 @@ package body Sem_Assocs is
(Get_Type (Inter))
then
Error_Msg_Sem
- ("unconstrained " & Disp_Node (Inter)
- & " must be connected", Loc);
+ (+Loc,
+ "unconstrained %n must be connected",
+ +Inter);
Match := Not_Compatible;
return;
end if;
@@ -1949,8 +1947,7 @@ package body Sem_Assocs is
end case;
end if;
when Iir_Kind_Interface_Package_Declaration =>
- Error_Msg_Sem
- (Disp_Node (Inter) & " must be associated", Loc);
+ Error_Msg_Sem (+Loc, "%n must be associated", +Inter);
Match := Not_Compatible;
when others =>
Error_Kind ("sem_association_chain", Inter);
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index a78f52b6e..a2b7101e9 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -24,7 +24,6 @@ with Std_Package; use Std_Package;
with Ieee.Std_Logic_1164;
with Iir_Chains;
with Evaluation; use Evaluation;
-with Name_Table;
with Iirs_Utils; use Iirs_Utils;
with Sem; use Sem;
with Sem_Expr; use Sem_Expr;
@@ -86,8 +85,7 @@ package body Sem_Decls is
begin
Decl_Type := Get_Type (Decl);
if Get_Signal_Type_Flag (Decl_Type) = False then
- Error_Msg_Sem ("type of " & Disp_Node (Decl)
- & " cannot be " & Disp_Node (Decl_Type), Decl);
+ Error_Msg_Sem (+Decl, "type of %n cannot be %n", (+Decl, +Decl_Type));
case Get_Kind (Decl_Type) is
when Iir_Kind_File_Type_Definition =>
null;
@@ -99,8 +97,8 @@ package body Sem_Decls is
when Iir_Kinds_Array_Type_Definition
| Iir_Kind_Record_Type_Definition
| Iir_Kind_Record_Subtype_Definition =>
- Error_Msg_Sem ("(" & Disp_Node (Decl_Type)
- & " has an access subelement)", Decl);
+ Error_Msg_Sem
+ (+Decl, "(%n has an access subelement)", +Decl_Type);
when others =>
Error_Kind ("check_signal_type", Decl_Type);
end case;
@@ -173,8 +171,8 @@ package body Sem_Decls is
-- a resolved signal.
if not Get_Resolved_Flag (A_Type) then
Error_Msg_Sem
- (Disp_Node (A_Type) & " of guarded "
- & Disp_Node (Inter) & " is not resolved", Inter);
+ (+Inter, "%n of guarded %n is not resolved",
+ (+A_Type, +Inter));
end if;
-- LRM 2.1.1.2 Signal parameter
@@ -184,13 +182,13 @@ package body Sem_Decls is
and then Interface_Kind in Parameter_Interface_List
then
Error_Msg_Sem
- ("signal parameter can't be of kind bus", Inter);
+ (+Inter, "signal parameter can't be of kind bus");
end if;
when Iir_Register_Kind =>
-- LRM93 4.3.2 Interface declarations
-- Grammar for interface_signal_declaration.
Error_Msg_Sem
- ("interface signal can't be of kind register", Inter);
+ (+Inter, "interface signal can't be of kind register");
end case;
end if;
Set_Type_Has_Signal (A_Type);
@@ -211,8 +209,9 @@ package body Sem_Decls is
case Get_Kind (Get_Base_Type (A_Type)) is
when Iir_Kind_File_Type_Definition =>
if Flags.Vhdl_Std >= Vhdl_93 then
- Error_Msg_Sem ("variable formal type can't be a "
- & "file type (vhdl 93)", Inter);
+ Error_Msg_Sem
+ (+Inter,
+ "variable formal can't be a file (vhdl 93)");
end if;
when Iir_Kind_Protected_Type_Declaration =>
-- LRM 2.1.1.1 Constant and variable parameters
@@ -220,7 +219,8 @@ package body Sem_Decls is
-- other that INOUT.
if Get_Mode (Inter) /= Iir_Inout_Mode then
Error_Msg_Sem
- ("parameter of protected type must be inout", Inter);
+ (+Inter,
+ "parameter of protected type must be inout");
end if;
when others =>
null;
@@ -230,7 +230,7 @@ package body Sem_Decls is
/= Iir_Kind_File_Type_Definition
then
Error_Msg_Sem
- ("file formal type must be a file type", Inter);
+ (+Inter, "file formal type must be a file type");
end if;
when others =>
-- Inter is not an interface.
@@ -256,22 +256,23 @@ package body Sem_Decls is
when Iir_Kind_Interface_Signal_Declaration =>
if Get_Mode (Inter) = Iir_Linkage_Mode then
Error_Msg_Sem
- ("default expression not allowed for linkage port",
- Inter);
+ (+Inter,
+ "default expression not allowed for linkage port");
elsif Interface_Kind in Parameter_Interface_List then
- Error_Msg_Sem ("default expression not allowed"
- & " for signal parameter", Inter);
+ Error_Msg_Sem
+ (+Inter,
+ "default expression not allowed for signal parameter");
end if;
when Iir_Kind_Interface_Variable_Declaration =>
if Get_Mode (Inter) /= Iir_In_Mode then
Error_Msg_Sem
- ("default expression not allowed for"
- & " out or inout variable parameter", Inter);
+ (+Inter, "default expression not allowed for"
+ & " out or inout variable parameter");
elsif Get_Kind (A_Type) = Iir_Kind_Protected_Type_Declaration
then
Error_Msg_Sem
- ("default expression not allowed for"
- & " variable parameter of protected type", Inter);
+ (+Inter, "default expression not allowed for"
+ & " variable parameter of protected type");
end if;
when Iir_Kind_Interface_File_Declaration =>
raise Internal_Error;
@@ -296,9 +297,7 @@ package body Sem_Decls is
-- generic constants whose values may be determined by the
-- environment.
if Get_Kind (Inter) /= Iir_Kind_Interface_Constant_Declaration then
- Error_Msg_Sem
- ("generic " & Disp_Node (Inter) & " must be a constant",
- Inter);
+ Error_Msg_Sem (+Inter, "generic %n must be a constant", +Inter);
else
-- LRM93 7.4.2 (Globally static primaries)
-- 3. a generic constant.
@@ -314,16 +313,14 @@ package body Sem_Decls is
end if;
when Port_Interface_List =>
if Get_Kind (Inter) /= Iir_Kind_Interface_Signal_Declaration then
- Error_Msg_Sem
- ("port " & Disp_Node (Inter) & " must be a signal", Inter);
+ Error_Msg_Sem (+Inter, "port %n must be a signal", +Inter);
end if;
when Parameter_Interface_List =>
if Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration
and then Interface_Kind = Function_Parameter_Interface_List
then
- Error_Msg_Sem ("variable interface parameter are not "
- & "allowed for a function (use a constant)",
- Inter);
+ Error_Msg_Sem (+Inter, "variable interface parameter are not "
+ & "allowed for a function (use a constant)");
end if;
-- By default, we suppose a subprogram read the activity of
@@ -346,13 +343,15 @@ package body Sem_Decls is
and then
Get_Kind (Inter) /= Iir_Kind_Interface_File_Declaration
then
- Error_Msg_Sem ("mode of a function parameter cannot "
- & "be inout or out", Inter);
+ Error_Msg_Sem
+ (+Inter,
+ "mode of a function parameter cannot be inout or out");
end if;
when Iir_Buffer_Mode
| Iir_Linkage_Mode =>
- Error_Msg_Sem ("buffer or linkage mode is not allowed "
- & "for a subprogram parameter", Inter);
+ Error_Msg_Sem
+ (+Inter, "buffer or linkage mode is not allowed "
+ & "for a subprogram parameter");
end case;
end case;
end Sem_Interface_Object_Declaration;
@@ -1594,7 +1593,7 @@ package body Sem_Decls is
/= Iir_Kind_Package_Body
then
Error_Msg_Sem
- ("full constant declaration must appear in package body", Decl);
+ (+Decl, "full constant declaration must appear in package body");
end if;
return Deferred_Const;
end Get_Deferred_Constant;
@@ -1671,8 +1670,8 @@ package body Sem_Decls is
Get_Type (Deferred_Const))
then
Error_Msg_Sem
- ("subtype indication doesn't conform with the deferred constant",
- Decl);
+ (+Decl,
+ "subtype indication doesn't conform with the deferred constant");
end if;
-- LRM93 4.3.1.3
@@ -1689,7 +1688,7 @@ package body Sem_Decls is
-- a file type [or an access type].
case Get_Kind (Atype) is
when Iir_Kind_File_Type_Definition =>
- Error_Msg_Sem (Disp_Node (Decl) & " cannot be of type file", Decl);
+ Error_Msg_Sem (+Decl, "%n cannot be of type file", +Decl);
when others =>
if Get_Kind (Decl) /= Iir_Kind_Variable_Declaration then
Check_Signal_Type (Decl);
@@ -1698,7 +1697,7 @@ package body Sem_Decls is
if not Check_Implicit_Conversion (Atype, Default_Value) then
Error_Msg_Sem
- ("default value length does not match object type length", Decl);
+ (+Decl, "default value length does not match object type length");
end if;
case Get_Kind (Decl) is
@@ -1716,13 +1715,14 @@ package body Sem_Decls is
if Default_Value = Null_Iir then
if Deferred_Const /= Null_Iir then
Error_Msg_Sem
- ("full constant declaration must have a default value",
- Decl);
+ (+Decl,
+ "full constant declaration must have a default value");
else
Set_Deferred_Declaration_Flag (Decl, True);
end if;
if Get_Kind (Parent) /= Iir_Kind_Package_Declaration then
- Error_Msg_Sem ("a constant must have a default value", Decl);
+ Error_Msg_Sem
+ (+Decl, "a constant must have a default value");
end if;
Set_Expr_Staticness (Decl, Globally);
else
@@ -1759,8 +1759,7 @@ package body Sem_Decls is
if Get_Guarded_Signal_Flag (Decl)
and then not Get_Resolved_Flag (Atype)
then
- Error_Msg_Sem
- ("guarded " & Disp_Node (Decl) & " must be resolved", Decl);
+ Error_Msg_Sem (+Decl, "guarded %n must be resolved", +Decl);
end if;
Set_Expr_Staticness (Decl, None);
Set_Has_Disconnect_Flag (Decl, False);
@@ -1785,21 +1784,22 @@ package body Sem_Decls is
| Iir_Kind_Generate_Statement_Body =>
if not Get_Shared_Flag (Decl) then
Error_Msg_Sem
- ("non shared variable declaration not allowed here",
- Decl);
+ (+Decl,
+ "non shared variable declaration not allowed here");
end if;
when Iir_Kinds_Process_Statement
| Iir_Kind_Function_Body
| Iir_Kind_Procedure_Body =>
if Get_Shared_Flag (Decl) then
Error_Msg_Sem
- ("shared variable declaration not allowed here", Decl);
+ (+Decl,
+ "shared variable declaration not allowed here");
end if;
when Iir_Kind_Protected_Type_Body =>
if Get_Shared_Flag (Decl) then
Error_Msg_Sem
- ("variable of protected type body must not be shared",
- Decl);
+ (+Decl,
+ "variable of protected type body must not be shared");
end if;
when Iir_Kind_Protected_Type_Declaration =>
-- This is not allowed, but caught
@@ -1839,9 +1839,8 @@ package body Sem_Decls is
and then Base_Type
= Get_Protected_Type_Declaration (Parent)
then
- Error_Msg_Sem
- ("variable type must not be of the protected type body",
- Decl);
+ Error_Msg_Sem (+Decl, "variable type must not be of the "
+ & "protected type body");
end if;
end;
end if;
@@ -1869,11 +1868,11 @@ package body Sem_Decls is
-- must define a constrained array subtype.
if not Is_Fully_Constrained_Type (Atype) then
Error_Msg_Sem
- ("declaration of " & Disp_Node (Decl)
- & " with unconstrained " & Disp_Node (Atype)
- & " is not allowed", Decl);
+ (+Decl,
+ "declaration of %n with unconstrained %n is not allowed",
+ (+Decl, +Atype));
if Default_Value /= Null_Iir then
- Error_Msg_Sem ("(even with a default value)", Decl);
+ Error_Msg_Sem (+Decl, "(even with a default value)");
end if;
end if;
@@ -1910,7 +1909,7 @@ package body Sem_Decls is
-- The subtype indication of a file declaration must define a file
-- subtype.
if Get_Kind (Atype) /= Iir_Kind_File_Type_Definition then
- Error_Msg_Sem ("file subtype expected for a file declaration", Decl);
+ Error_Msg_Sem (+Decl, "file subtype expected for a file declaration");
return;
end if;
@@ -2002,8 +2001,7 @@ package body Sem_Decls is
or else (Flags.Vhdl_Std > Vhdl_87
and then Ident in Std_Names.Name_Id_Vhdl93_Attributes)
then
- Error_Msg_Sem ("predefined attribute """ & Name_Table.Image (Ident)
- & """ overriden", Decl);
+ Error_Msg_Sem (+Decl, "predefined attribute %i overriden", +Decl);
end if;
Sem_Scopes.Add_Name (Decl);
Xref_Decl (Decl);
@@ -2054,7 +2052,7 @@ package body Sem_Decls is
--
-- 2. The name must be a static name that denotes an object.
if Get_Name_Staticness (N_Name) < Globally then
- Error_Msg_Sem ("aliased name must be a static name", Alias);
+ Error_Msg_Sem (+Alias, "aliased name must be a static name");
end if;
-- LRM93 4.3.3.1
@@ -2074,8 +2072,8 @@ package body Sem_Decls is
if N_Type /= Null_Iir then
Set_Type (Alias, N_Type);
if Get_Base_Type (N_Type) /= Get_Base_Type (Name_Type) then
- Error_Msg_Sem ("base type of aliased name and name mismatch",
- Alias);
+ Error_Msg_Sem
+ (+Alias, "base type of aliased name and name mismatch");
end if;
end if;
end if;
@@ -2085,8 +2083,8 @@ package body Sem_Decls is
if Get_Kind (N_Type) in Iir_Kinds_Array_Type_Definition then
if not Is_One_Dimensional_Array_Type (N_Type) then
Error_Msg_Sem
- ("aliased name must not be a multi-dimensional array type",
- Alias);
+ (+Alias,
+ "aliased name must not be a multi-dimensional array type");
end if;
if Get_Type_Staticness (N_Type) = Locally
and then Get_Type_Staticness (Name_Type) = Locally
@@ -2096,7 +2094,7 @@ package body Sem_Decls is
(Get_Nth_Element (Get_Index_Subtype_List (Name_Type), 0))
then
Error_Msg_Sem
- ("number of elements not matching in type and name", Alias);
+ (+Alias, "number of elements not matching in type and name");
end if;
end if;
@@ -2229,12 +2227,13 @@ package body Sem_Decls is
else
Error := True;
Error_Msg_Sem
- ("cannot resolve signature, many matching subprograms:",
- Sig);
- Error_Msg_Sem ("found: " & Disp_Node (Res), Res);
+ (+Sig,
+ "cannot resolve signature, many matching subprograms:",
+ Cont => True);
+ Error_Msg_Sem (+Res, "found: %n", (1 => +Res), Cont => True);
end if;
if Error then
- Error_Msg_Sem ("found: " & Disp_Node (El), El);
+ Error_Msg_Sem (+El, "found: %n", +El);
end if;
end if;
end loop;
@@ -2258,7 +2257,7 @@ package body Sem_Decls is
end if;
if Res = Null_Iir then
Error_Msg_Sem
- ("cannot resolve signature, no matching subprogram", Sig);
+ (+Sig, "cannot resolve signature, no matching subprogram");
end if;
return Res;
@@ -2415,12 +2414,12 @@ package body Sem_Decls is
-- 2. A signature is required if the name denotes a subprogram
-- (including an operator) or enumeration literal.
if Get_Alias_Signature (Alias) = Null_Iir then
- Error_Msg_Sem ("signature required for subprogram", Alias);
+ Error_Msg_Sem (+Alias, "signature required for subprogram");
end if;
when Iir_Kind_Enumeration_Literal =>
if Get_Alias_Signature (Alias) = Null_Iir then
- Error_Msg_Sem ("signature required for enumeration literal",
- Alias);
+ Error_Msg_Sem
+ (+Alias, "signature required for enumeration literal");
end if;
when Iir_Kind_Type_Declaration =>
Add_Aliases_For_Type_Alias (Alias);
@@ -2438,7 +2437,7 @@ package body Sem_Decls is
when Iir_Kind_Terminal_Declaration =>
null;
when Iir_Kind_Base_Attribute =>
- Error_Msg_Sem ("base attribute not allowed in alias", Alias);
+ Error_Msg_Sem (+Alias, "base attribute not allowed in alias");
return;
when others =>
Error_Kind ("sem_non_object_alias_declaration", N_Entity);
@@ -2453,8 +2452,8 @@ package body Sem_Decls is
-- name must denote an enumeration literal.
if Get_Kind (N_Entity) /= Iir_Kind_Enumeration_Literal then
Error_Msg_Sem
- ("alias of a character must denote an enumeration literal",
- Alias);
+ (+Alias,
+ "alias of a character must denote an enumeration literal");
return;
end if;
when Name_Id_Operators
@@ -2468,7 +2467,7 @@ package body Sem_Decls is
-- requirements of 2.3.1.
if Get_Kind (N_Entity) /= Iir_Kind_Function_Declaration then
Error_Msg_Sem
- ("alias of an operator must denote a function", Alias);
+ (+Alias, "alias of an operator must denote a function");
return;
end if;
Check_Operator_Requirements (Id, N_Entity);
@@ -2506,7 +2505,7 @@ package body Sem_Decls is
if Is_Overload_List (N_Entity) then
if Sig = Null_Iir then
Error_Msg_Sem
- ("signature required for alias of a subprogram", Alias);
+ (+Alias, "signature required for alias of a subprogram");
return Alias;
end if;
end if;
@@ -2529,7 +2528,7 @@ package body Sem_Decls is
Name_Visible (Alias);
if Sig /= Null_Iir then
- Error_Msg_Sem ("signature not allowed for object alias", Sig);
+ Error_Msg_Sem (+Sig, "signature not allowed for object alias");
end if;
Sem_Object_Alias_Declaration (Alias);
return Alias;
@@ -2538,8 +2537,8 @@ package body Sem_Decls is
if Get_Subtype_Indication (Alias) /= Null_Iir then
Error_Msg_Sem
- ("subtype indication shall not appear in a nonobject alias",
- Alias);
+ (+Alias,
+ "subtype indication shall not appear in a nonobject alias");
end if;
Res := Create_Iir (Iir_Kind_Non_Object_Alias_Declaration);
@@ -2559,7 +2558,7 @@ package body Sem_Decls is
Sem_Non_Object_Alias_Declaration (Res);
else
Error_Msg_Sem
- ("name of nonobject alias is not a declaration", Name);
+ (+Name, "name of nonobject alias is not a declaration");
-- Create a simple name to an error node.
N_Entity := Create_Error (Name);
@@ -2617,7 +2616,7 @@ package body Sem_Decls is
if El_Entity = Null_Iir then
Error_Msg_Sem
- ("too many elements in group constituent list", Group);
+ (+Group, "too many elements in group constituent list");
exit;
end if;
@@ -2649,9 +2648,7 @@ package body Sem_Decls is
-- by the corresponding entity class entry in the entity class
-- entry list of the group template.
if Get_Entity_Class_Kind (El_Name) /= Class then
- Error_Msg_Sem
- ("constituent not of class '" & Tokens.Image (Class) & ''',
- El);
+ Error_Msg_Sem (+El, "constituent not of class %t", +Class);
end if;
end if;
end loop;
@@ -2661,7 +2658,7 @@ package body Sem_Decls is
or else Get_Entity_Class (El_Entity) = Tok_Box)
then
Error_Msg_Sem
- ("not enough elements in group constituent list", Group);
+ (+Group, "not enough elements in group constituent list");
end if;
Set_Visible_Flag (Group, True);
end Sem_Group_Declaration;
@@ -2684,7 +2681,7 @@ package body Sem_Decls is
| Iir_Kind_Floating_Type_Definition =>
return Res;
when others =>
- Error_Msg_Sem (Name & "type must be a floating point type", T);
+ Error_Msg_Sem (+T, Name & "type must be a floating point type");
return Real_Type_Definition;
end case;
end Sem_Scalar_Nature_Typemark;
@@ -3032,8 +3029,9 @@ package body Sem_Decls is
when Iir_Kind_Constant_Declaration =>
if Get_Deferred_Declaration_Flag (El) then
if Get_Deferred_Declaration (El) = Null_Iir then
- Error_Msg_Sem ("missing value for constant declared at "
- & Disp_Location (El), Decl);
+ Error_Msg_Sem
+ (+Decl,
+ "missing value for constant declared at %l", +El);
end if;
end if;
when Iir_Kind_Function_Declaration
@@ -3041,9 +3039,8 @@ package body Sem_Decls is
if not Is_Implicit_Subprogram (El)
and then Get_Subprogram_Body (El) = Null_Iir
then
- Error_Msg_Sem ("missing body for " & Disp_Node (El)
- & " declared at "
- & Disp_Location (El), Decl);
+ Error_Msg_Sem
+ (+Decl, "missing body for %n declared at %l", (+El, +El));
end if;
when Iir_Kind_Type_Declaration =>
declare
@@ -3053,13 +3050,13 @@ package body Sem_Decls is
if Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition
and then Get_Type_Declarator (Def) = El
then
- Error_Msg_Sem ("missing full type declaration for "
- & Disp_Node (El), El);
+ Error_Msg_Sem
+ (+El, "missing full type declaration for %n", +El);
elsif Get_Kind (Def) = Iir_Kind_Protected_Type_Declaration
and then Get_Protected_Type_Body (Def) = Null_Iir
then
- Error_Msg_Sem ("missing protected type body for "
- & Disp_Node (El), El);
+ Error_Msg_Sem
+ (+El, "missing protected type body for %n", +El);
end if;
end;
when others =>
diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index 381068e88..4f6ec0df8 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -370,8 +370,7 @@ package body Sem_Expr is
| Iir_Kind_Attribute_Declaration
| Iir_Kind_Psl_Declaration
| Iir_Kind_Signature =>
- Error_Msg_Sem (Disp_Node (Expr)
- & " not allowed in an expression", Loc);
+ Error_Msg_Sem (+Loc, "%n not allowed in an expression", +Expr);
return Null_Iir;
when Iir_Kind_Function_Declaration =>
return Expr;
@@ -580,11 +579,11 @@ package body Sem_Expr is
-- Check for string or aggregate literals
-- FIXME: improve error message
if Left_Type = Null_Iir then
- Error_Msg_Sem ("bad expression for a scalar", Left);
+ Error_Msg_Sem (+Left, "bad expression for a scalar");
return Null_Iir;
end if;
if Right_Type = Null_Iir then
- Error_Msg_Sem ("bad expression for a scalar", Right);
+ Error_Msg_Sem (+Right, "bad expression for a scalar");
return Null_Iir;
end if;
@@ -617,8 +616,8 @@ package body Sem_Expr is
else
-- FIXME: handle overload
Error_Msg_Sem
- ("left and right expressions of range are not compatible",
- Expr);
+ (+Expr,
+ "left and right expressions of range are not compatible");
return Null_Iir;
end if;
end if;
@@ -632,8 +631,8 @@ package body Sem_Expr is
Get_Base_Type (Right_Type));
if Expr_Type = Null_Iir then
Error_Msg_Sem
- ("left and right expressions of range are not compatible",
- Expr);
+ (+Expr,
+ "left and right expressions of range are not compatible");
return Null_Iir;
end if;
end if;
@@ -650,7 +649,7 @@ package body Sem_Expr is
else
if Are_Types_Compatible (Expr_Type, A_Type) = Not_Compatible then
Error_Msg_Sem
- ("type of range doesn't match expected type", Expr);
+ (+Expr, "type of range doesn't match expected type");
return Null_Iir;
end if;
@@ -668,7 +667,7 @@ package body Sem_Expr is
if A_Type /= Null_Iir
and then Are_Types_Compatible (Expr_Type, A_Type) = Not_Compatible
then
- Error_Msg_Sem ("type of range doesn't match expected type", Expr);
+ Error_Msg_Sem (+Expr, "type of range doesn't match expected type");
return Null_Iir;
end if;
@@ -676,7 +675,7 @@ package body Sem_Expr is
if Get_Kind (Get_Base_Type (Expr_Type))
not in Iir_Kinds_Scalar_Type_Definition
then
- Error_Msg_Sem ("type of range is not a scalar type", Expr);
+ Error_Msg_Sem (+Expr, "type of range is not a scalar type");
return Null_Iir;
end if;
@@ -732,7 +731,7 @@ package body Sem_Expr is
| Iir_Kind_Reverse_Range_Array_Attribute =>
Res_Type := Get_Type (Res);
when others =>
- Error_Msg_Sem ("name must denote a range", Expr);
+ Error_Msg_Sem (+Expr, "name must denote a range");
return Null_Iir;
end case;
if A_Type /= Null_Iir
@@ -743,12 +742,12 @@ package body Sem_Expr is
end if;
when others =>
- Error_Msg_Sem ("range expression required", Expr);
+ Error_Msg_Sem (+Expr, "range expression required");
return Null_Iir;
end case;
if Get_Kind (Res_Type) not in Iir_Kinds_Scalar_Type_Definition then
- Error_Msg_Sem (Disp_Node (Res) & " is not a range type", Expr);
+ Error_Msg_Sem (+Expr, "%n is not a range type", +Res);
return Null_Iir;
end if;
@@ -786,9 +785,8 @@ package body Sem_Expr is
then
-- A_TYPE is known when analyzing an index_constraint within
-- a subtype indication.
- Error_Msg_Sem ("subtype " & Disp_Node (Res)
- & " doesn't match expected type "
- & Disp_Node (A_Type), Expr);
+ Error_Msg_Sem (+Expr, "subtype %n doesn't match expected type %n",
+ (+Res, +A_Type));
-- FIXME: override type of RES ?
end if;
else
@@ -806,10 +804,10 @@ package body Sem_Expr is
if Get_Kind (Res_Type) /= Iir_Kind_Error then
-- FIXME: avoid that test with error.
if Get_Kind (Res) not in Iir_Kinds_Denoting_Name then
- Error_Msg_Sem ("range is not discrete", Res);
+ Error_Msg_Sem (+Res, "range is not discrete");
else
Error_Msg_Sem
- (Disp_Node (Res) & " is not a discrete range type", Expr);
+ (+Expr, "%n is not a discrete range type", +Res);
end if;
end if;
return Null_Iir;
@@ -866,8 +864,8 @@ package body Sem_Expr is
"universal integer bound must be numeric literal "
& "or attribute");
else
- Error_Msg_Sem ("universal integer bound must be numeric literal "
- & "or attribute", Res);
+ Error_Msg_Sem (+Res, "universal integer bound must be numeric "
+ & "literal or attribute");
end if;
Set_Type (Res, Integer_Type_Definition);
end if;
@@ -1053,11 +1051,10 @@ package body Sem_Expr is
procedure Error_Wait is
begin
Error_Msg_Sem
- (Disp_Node (Subprg) & " must not contain wait statement, but calls",
- Loc);
+ (+Loc, "%n must not contain wait statement, but calls",
+ (1 => +Subprg), Cont => True);
Error_Msg_Sem
- (Disp_Node (Callee) & " which has (indirectly) a wait statement",
- Callee);
+ (+Callee, "%n which has (indirectly) a wait statement", +Callee);
--Error_Msg_Sem
-- ("(indirect) wait statement not allowed in " & Where, Loc);
end Error_Wait;
@@ -1142,12 +1139,11 @@ package body Sem_Expr is
-- signal whose explicit ancestor is not a formal signal
-- parameter or member of a formal parameter of
-- the subprogram or of any of its parents.
+ Error_Msg_Sem (+Loc, "all-sensitized %n can't call %n",
+ (+Subprg, +Callee), Cont => True);
Error_Msg_Sem
- ("all-sensitized " & Disp_Node (Subprg)
- & " can't call " & Disp_Node (Callee), Loc);
- Error_Msg_Sem
- (" (as this subprogram reads (indirectly) a signal)",
- Loc);
+ (+Loc,
+ " (as this subprogram reads (indirectly) a signal)");
end if;
when Iir_Kind_Process_Statement =>
return;
@@ -1211,9 +1207,8 @@ package body Sem_Expr is
when Iir_Kinds_Process_Statement =>
if Get_Passive_Flag (Subprg) then
Error_Msg_Sem
- (Disp_Node (Subprg)
- & " is passive, but calls non-passive "
- & Disp_Node (Imp), Expr);
+ (+Expr, "%n is passive, but calls non-passive %n",
+ (+Subprg, +Imp));
end if;
when others =>
null;
@@ -1298,7 +1293,7 @@ package body Sem_Expr is
when 0 =>
-- FIXME: display subprogram name.
Error_Msg_Sem
- ("cannot resolve overloading for subprogram call", Expr);
+ (+Expr, "cannot resolve overloading for subprogram call");
return Null_Iir;
when 1 =>
@@ -1390,12 +1385,12 @@ package body Sem_Expr is
-- Only one interpretation for the subprogram name.
if Is_Func then
if Get_Kind (Inter_List) /= Iir_Kind_Function_Declaration then
- Error_Msg_Sem ("name does not designate a function", Expr);
+ Error_Msg_Sem (+Expr, "name does not designate a function");
return Null_Iir;
end if;
else
if Get_Kind (Inter_List) /= Iir_Kind_Procedure_Declaration then
- Error_Msg_Sem ("name does not designate a procedure", Expr);
+ Error_Msg_Sem (+Expr, "name does not designate a procedure");
return Null_Iir;
end if;
end if;
@@ -1735,8 +1730,7 @@ package body Sem_Expr is
-- Note: operator and implementation node of expr must be set.
procedure Error_Operator_Overload (List : Iir_List) is
begin
- Error_Msg_Sem ("operator """ & Name_Table.Image (Operator)
- & """ is overloaded", Expr);
+ Error_Msg_Sem (+Expr, "operator ""%i"" is overloaded", +Operator);
Disp_Overload_List (List, Expr);
end Error_Operator_Overload;
@@ -1850,8 +1844,7 @@ package body Sem_Expr is
-- The list of possible implementations was computed.
case Get_Nbr_Elements (Overload_List) is
when 0 =>
- Error_Msg_Sem
- ("no function declarations for " & Disp_Node (Expr), Expr);
+ Error_Msg_Sem (+Expr, "no function declarations for %n", +Expr);
Destroy_Iir_List (Overload_List);
return Null_Iir;
@@ -1904,7 +1897,7 @@ package body Sem_Expr is
Decl := Get_Explicit_Subprogram (Overload_List);
if Decl /= Null_Iir then
Error_Msg_Sem
- ("(you may want to use the -fexplicit option)", Expr);
+ (+Expr, "(you may want to use the -fexplicit option)");
Explicit_Advice_Given := True;
end if;
end if;
@@ -1974,12 +1967,11 @@ package body Sem_Expr is
then
-- ... because it is not defined.
Error_Msg_Sem
- ("type " & Disp_Node (Etype) & " does not define character '"
- & C & "'", Str);
+ (+Str, "type %n does not define character %c", (+Etype, +C));
else
-- ... because it is not visible.
- Error_Msg_Sem ("character '" & C & "' of type "
- & Disp_Node (Etype) & " is not visible", Str);
+ Error_Msg_Sem (+Str, "character %c of type %n is not visible",
+ (+C, +Etype));
end if;
return Null_Iir;
end Find_Literal;
@@ -2040,8 +2032,8 @@ package body Sem_Expr is
Index_Type := Get_Index_Type (Lit_Type, 0);
if Get_Type_Staticness (Index_Type) = Locally then
if Eval_Discrete_Type_Length (Index_Type) /= Iir_Int64 (Len) then
- Error_Msg_Sem ("string length does not match that of "
- & Disp_Node (Index_Type), Lit);
+ Error_Msg_Sem (+Lit, "string length does not match that of %n",
+ +Index_Type);
end if;
else
-- FIXME: emit a warning because of dubious construct (the type
@@ -2179,7 +2171,7 @@ package body Sem_Expr is
end if;
Set_Choice_Expression (Choice, Expr);
if Get_Expr_Staticness (Expr) < Locally then
- Error_Msg_Sem ("choice must be locally static expression", Expr);
+ Error_Msg_Sem (+Expr, "choice must be locally static expression");
Has_Length_Error := True;
return;
end if;
@@ -2187,14 +2179,14 @@ package body Sem_Expr is
Set_Choice_Expression (Choice, Expr);
if Get_Kind (Expr) = Iir_Kind_Overflow_Literal then
Error_Msg_Sem
- ("bound error during evaluation of choice expression", Expr);
+ (+Expr, "bound error during evaluation of choice expression");
Has_Length_Error := True;
elsif Eval_Discrete_Type_Length
(Get_String_Type_Bound_Type (Get_Type (Expr))) /= Sel_Length
then
Has_Length_Error := True;
Error_Msg_Sem
- ("value not of the same length of the case expression", Expr);
+ (+Expr, "value not of the same length of the case expression");
return;
end if;
end Sem_Simple_Choice;
@@ -2206,11 +2198,12 @@ package body Sem_Expr is
Sel_Type := Get_Type (Sel);
if not Is_One_Dimensional_Array_Type (Sel_Type) then
Error_Msg_Sem
- ("expression must be discrete or one-dimension array subtype", Sel);
+ (+Sel,
+ "expression must be discrete or one-dimension array subtype");
return;
end if;
if Get_Type_Staticness (Sel_Type) /= Locally then
- Error_Msg_Sem ("array type must be locally static", Sel);
+ Error_Msg_Sem (+Sel, "array type must be locally static");
return;
end if;
Sel_Length := Eval_Discrete_Type_Length
@@ -2227,16 +2220,16 @@ package body Sem_Expr is
raise Internal_Error;
when Iir_Kind_Choice_By_Range =>
Error_Msg_Sem
- ("range choice are not allowed for non-discrete type", El);
+ (+El, "range choice are not allowed for non-discrete type");
when Iir_Kind_Choice_By_Expression =>
Nbr_Choices := Nbr_Choices + 1;
Sem_Simple_Choice (El);
when Iir_Kind_Choice_By_Others =>
if Has_Others then
- Error_Msg_Sem ("duplicate others choice", El);
+ Error_Msg_Sem (+El, "duplicate others choice");
elsif Get_Chain (El) /= Null_Iir then
Error_Msg_Sem
- ("choice others must be the last alternative", El);
+ (+El, "choice others must be the last alternative");
end if;
Has_Others := True;
when others =>
@@ -2278,9 +2271,8 @@ package body Sem_Expr is
-- 3. Check for duplicate choices
for I in 1 .. Nbr_Choices - 1 loop
if Eq (I, I + 1) then
- Error_Msg_Sem ("duplicate choice with choice at " &
- Disp_Location (Arr (I + 1)),
- Arr (I));
+ Error_Msg_Sem
+ (+Arr (I), "duplicate choice with choice at %l", +Arr (I + 1));
exit;
end if;
end loop;
@@ -2298,7 +2290,7 @@ package body Sem_Expr is
for I in 1 .. Sel_Length loop
Nbr := Nbr / Sel_El_Length;
if Nbr = 0 then
- Error_Msg_Sem ("missing choice(s)", Choice_Chain);
+ Error_Msg_Sem (+Choice_Chain, "missing choice(s)");
exit;
end if;
end loop;
@@ -2455,8 +2447,7 @@ package body Sem_Expr is
end if;
end if;
if not Ok then
- Error_Msg_Sem
- (Disp_Node (Expr) & " out of index range", Choice);
+ Error_Msg_Sem (+Choice, "%n out of index range", +Expr);
end if;
end if;
if Ok then
@@ -2504,11 +2495,11 @@ package body Sem_Expr is
is
begin
if L = H then
- Error_Msg_Sem ("no choice for " & Disp_Discrete (Bt, L), Loc);
+ Error_Msg_Sem (+Loc, "no choice for " & Disp_Discrete (Bt, L));
else
Error_Msg_Sem
- ("no choices for " & Disp_Discrete (Bt, L)
- & " to " & Disp_Discrete (Bt, H), Loc);
+ (+Loc, "no choices for " & Disp_Discrete (Bt, L)
+ & " to " & Disp_Discrete (Bt, H));
end if;
end Error_No_Choice;
@@ -2556,12 +2547,13 @@ package body Sem_Expr is
elsif Pos > E_Pos then
if Pos = E_Pos + 1 then
Error_Msg_Sem
- ("duplicate choice for " & Disp_Discrete (Bt, E_Pos),
- Arr (I));
+ (+Arr (I),
+ "duplicate choice for " & Disp_Discrete (Bt, E_Pos));
else
Error_Msg_Sem
- ("duplicate choices for " & Disp_Discrete (Bt, E_Pos)
- & " to " & Disp_Discrete (Bt, Pos), Arr (I));
+ (+Arr (I), "duplicate choices for "
+ & Disp_Discrete (Bt, E_Pos)
+ & " to " & Disp_Discrete (Bt, Pos));
end if;
end if;
Pos := Eval_Pos (Get_High (Arr (I))) + 1;
@@ -2723,7 +2715,7 @@ package body Sem_Expr is
and then Is_Case_Stmt
then
-- FIXME: explain why
- Error_Msg_Sem ("choice is not locally static", El);
+ Error_Msg_Sem (+El, "choice is not locally static");
end if;
else
Has_Error := True;
@@ -2736,10 +2728,10 @@ package body Sem_Expr is
raise Internal_Error;
when Iir_Kind_Choice_By_Others =>
if Has_Others then
- Error_Msg_Sem ("duplicate others choice", El);
+ Error_Msg_Sem (+El, "duplicate others choice");
elsif Get_Chain (El) /= Null_Iir then
Error_Msg_Sem
- ("choice others should be the last alternative", El);
+ (+El, "choice others should be the last alternative");
end if;
Has_Others := True;
when others =>
@@ -2759,7 +2751,7 @@ package body Sem_Expr is
-- rest (if any) of the element associations of an array aggregate
-- must be either all positionnal or all named.
Error_Msg_Sem
- ("element associations must be all positional or all named", Loc);
+ (+Loc, "element associations must be all positional or all named");
return;
end if;
@@ -2773,9 +2765,9 @@ package body Sem_Expr is
if (not Has_Others and not Is_Sub_Range)
and then Nbr_Pos < Pos_Max
then
- Error_Msg_Sem ("not enough elements associated", Loc);
+ Error_Msg_Sem (+Loc, "not enough elements associated");
elsif Nbr_Pos > Pos_Max then
- Error_Msg_Sem ("too many elements associated", Loc);
+ Error_Msg_Sem (+Loc, "too many elements associated");
end if;
return;
end if;
@@ -2798,7 +2790,7 @@ package body Sem_Expr is
-- element association and the element association has a single
-- choice.
if Nbr_Named > 1 or Has_Others then
- Error_Msg_Sem ("not static choice exclude others choice", Loc);
+ Error_Msg_Sem (+Loc, "not static choice exclude others choice");
end if;
end if;
return;
@@ -2909,8 +2901,7 @@ package body Sem_Expr is
Pos : constant Natural := Natural (Get_Element_Position (Rec_El));
begin
if Matches (Pos) /= Null_Iir then
- Error_Msg_Sem
- (Disp_Node (Matches (Pos)) & " was already associated", El);
+ Error_Msg_Sem (+El, "%n was already associated", +Matches (Pos));
Ok := False;
return;
end if;
@@ -2923,7 +2914,7 @@ package body Sem_Expr is
if El_Type = Null_Iir then
El_Type := Ass_Type;
elsif Are_Types_Compatible (El_Type, Ass_Type) = Not_Compatible then
- Error_Msg_Sem ("elements are not of the same type", El);
+ Error_Msg_Sem (+El, "elements are not of the same type");
Ok := False;
end if;
end Add_Match;
@@ -2939,15 +2930,14 @@ package body Sem_Expr is
begin
Expr := Get_Choice_Expression (Ass);
if Get_Kind (Expr) /= Iir_Kind_Simple_Name then
- Error_Msg_Sem ("element association must be a simple name", Ass);
+ Error_Msg_Sem (+Ass, "element association must be a simple name");
Ok := False;
return Ass;
end if;
Aggr_El := Find_Name_In_List
(Get_Elements_Declaration_List (Base_Type), Get_Identifier (Expr));
if Aggr_El = Null_Iir then
- Error_Msg_Sem
- ("record has no such element " & Disp_Node (Ass), Ass);
+ Error_Msg_Sem (+Ass, "record has no such element %n", +Ass);
Ok := False;
return Ass;
end if;
@@ -2996,10 +2986,11 @@ package body Sem_Expr is
case Get_Kind (El) is
when Iir_Kind_Choice_By_None =>
if Has_Named then
- Error_Msg_Sem ("positional association after named one", El);
+ Error_Msg_Sem
+ (+El, "positional association after named one");
Ok := False;
elsif Rec_El_Index > Matches'Last then
- Error_Msg_Sem ("too many elements", El);
+ Error_Msg_Sem (+El, "too many elements");
exit;
else
Add_Match (El, Get_Nth_Element (El_List, Rec_El_Index));
@@ -3019,7 +3010,7 @@ package body Sem_Expr is
Has_Named := True;
if Get_Chain (El) /= Null_Iir then
Error_Msg_Sem
- ("choice others must be the last alternative", El);
+ (+El, "choice others must be the last alternative");
end if;
declare
Found : Boolean := False;
@@ -3031,7 +3022,7 @@ package body Sem_Expr is
end if;
end loop;
if not Found then
- Error_Msg_Sem ("no element for choice others", El);
+ Error_Msg_Sem (+El, "no element for choice others");
Ok := False;
end if;
end;
@@ -3066,8 +3057,7 @@ package body Sem_Expr is
for I in Matches'Range loop
if Matches (I) = Null_Iir then
Error_Msg_Sem
- ("no value for " & Disp_Node (Get_Nth_Element (El_List, I)),
- Aggr);
+ (+Aggr, "no value for %n", +Get_Nth_Element (El_List, I));
Ok := False;
end if;
end loop;
@@ -3185,8 +3175,8 @@ package body Sem_Expr is
Len := Len + 1;
when Iir_Kind_Choice_By_Others =>
if not Constrained then
- Error_Msg_Sem ("'others' choice not allowed for an "
- & "aggregate in this context", Aggr);
+ Error_Msg_Sem (+Aggr, "'others' choice not allowed "
+ & "for an aggregate in this context");
Infos (Dim).Error := True;
return;
end if;
@@ -3253,8 +3243,8 @@ package body Sem_Expr is
(Get_Kind (Choice) /= Iir_Kind_Choice_By_Expression
and then Get_Kind (Choice) /= Iir_Kind_Choice_By_Range)
then
- Error_Msg_Sem ("non-locally static choice for an aggregate is "
- & "allowed only if only choice", Aggr);
+ Error_Msg_Sem (+Aggr, "non-locally static choice for an aggregate "
+ & "is allowed only if only choice");
Infos (Dim).Error := True;
return;
end if;
@@ -3373,12 +3363,12 @@ package body Sem_Expr is
/= Eval_Pos (Eval_Discrete_Range_Left (Get_Range_Constraint
(Index_Type)))
then
- Error_Msg_Sem ("subaggregate bounds mismatch", Aggr);
+ Error_Msg_Sem (+Aggr, "subaggregate bounds mismatch");
else
if Eval_Discrete_Type_Length (Info.Index_Subtype)
/= Iir_Int64 (Len)
then
- Error_Msg_Sem ("subaggregate length mismatch", Aggr);
+ Error_Msg_Sem (+Aggr, "subaggregate length mismatch");
end if;
end if;
else
@@ -3390,7 +3380,7 @@ package body Sem_Expr is
if Eval_Pos (L) /= Eval_Pos (Low)
or else Eval_Pos (H) /= Eval_Pos (H)
then
- Error_Msg_Sem ("subagregate bounds mismatch", Aggr);
+ Error_Msg_Sem (+Aggr, "subagregate bounds mismatch");
end if;
end;
end if;
@@ -3474,11 +3464,11 @@ package body Sem_Expr is
(Assoc, A_Type, Infos, Constrained, Dim + 1);
else
Error_Msg_Sem
- ("string literal not allowed here", Assoc);
+ (+Assoc, "string literal not allowed here");
Infos (Dim + 1).Error := True;
end if;
when others =>
- Error_Msg_Sem ("sub-aggregate expected", Assoc);
+ Error_Msg_Sem (+Assoc, "sub-aggregate expected");
Infos (Dim + 1).Error := True;
end case;
Choice := Get_Chain (Choice);
@@ -3600,8 +3590,7 @@ package body Sem_Expr is
end if;
return Expr;
when others =>
- Error_Msg_Sem ("type " & Disp_Node (A_Type) & " is not composite",
- Expr);
+ Error_Msg_Sem (+Expr, "type %n is not composite", +A_Type);
return Null_Iir;
end case;
end Sem_Aggregate;
@@ -3699,8 +3688,8 @@ package body Sem_Expr is
-- subtype or include an explicit index constraint.
if not Is_Fully_Constrained_Type (Arg) then
Error_Msg_Sem
- ("allocator of unconstrained " &
- Disp_Node (Arg) & " is not allowed", Expr);
+ (+Expr, "allocator of unconstrained %n is not allowed",
+ +Arg);
end if;
-- LRM93 7.3.6
-- A subtype indication that is part of an allocator must
@@ -3708,8 +3697,8 @@ package body Sem_Expr is
if Is_Anonymous_Type_Definition (Arg)
and then Get_Resolution_Indication (Arg) /= Null_Iir
then
- Error_Msg_Sem ("subtype indication must not include"
- & " a resolution function", Expr);
+ Error_Msg_Sem (+Expr, "subtype indication must not include"
+ & " a resolution function");
end if;
Arg_Type := Arg;
end case;
@@ -3728,7 +3717,7 @@ package body Sem_Expr is
if not Is_Allocator_Type (A_Type, Expr) then
if Get_Kind (A_Type) /= Iir_Kind_Access_Type_Definition then
if Get_Kind (A_Type) /= Iir_Kind_Error then
- Error_Msg_Sem ("expected type is not an access type", Expr);
+ Error_Msg_Sem (+Expr, "expected type is not an access type");
end if;
else
Error_Not_Match (Expr, A_Type);
@@ -3900,7 +3889,7 @@ package body Sem_Expr is
when Iir_Kind_Interface_Signal_Declaration
| Iir_Kind_Interface_Variable_Declaration =>
if not Can_Interface_Be_Read (Obj) then
- Error_Msg_Sem (Disp_Node (Obj) & " cannot be read", Expr);
+ Error_Msg_Sem (+Expr, "%n cannot be read", +Obj);
end if;
return;
when Iir_Kind_Enumeration_Literal
@@ -3995,7 +3984,7 @@ package body Sem_Expr is
or else (Get_Kind (Cur_Lib) = Iir_Kind_Package_Body
and then Get_Package (Cur_Lib) = Lib)
then
- Error_Msg_Sem ("invalid use of a deferred constant", Loc);
+ Error_Msg_Sem (+Loc, "invalid use of a deferred constant");
end if;
end Check_Constant_Restriction;
@@ -4154,7 +4143,7 @@ package body Sem_Expr is
return Expr;
end if;
if not Is_Null_Literal_Type (A_Type) then
- Error_Msg_Sem ("null literal can only be access type", Expr);
+ Error_Msg_Sem (+Expr, "null literal can only be access type");
return Null_Iir;
else
Set_Type (Expr, A_Type);
@@ -4195,8 +4184,7 @@ package body Sem_Expr is
return Sem_Allocator (Expr, A_Type);
when Iir_Kind_Procedure_Declaration =>
- Error_Msg_Sem
- (Disp_Node (Expr) & " cannot be used as an expression", Expr);
+ Error_Msg_Sem (+Expr, "%n cannot be used as an expression", +Expr);
return Null_Iir;
when Iir_Kind_Error =>
@@ -4642,7 +4630,7 @@ package body Sem_Expr is
Expr_Type := Get_Type (Expr1);
if Expr_Type = Null_Iir then
-- FIXME: improve message
- Error_Msg_Sem ("bad expression for a scalar", Expr);
+ Error_Msg_Sem (+Expr, "bad expression for a scalar");
return Null_Iir;
end if;
if not Is_Overload_List (Expr_Type) then
@@ -4693,10 +4681,10 @@ package body Sem_Expr is
-- Possible only if the type cannot be determined without the
-- context (aggregate or string literal).
Error_Msg_Sem
- ("cannot determine the type of choice expression", Expr);
+ (+Expr, "cannot determine the type of choice expression");
if Get_Kind (Expr1) = Iir_Kind_Aggregate then
Error_Msg_Sem
- ("(use a qualified expression of the form T'(xxx).)", Expr);
+ (+Expr, "(use a qualified expression of the form T'(xxx).)");
end if;
return Null_Iir;
end if;
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index b723782c1..5e1ad2cc1 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -50,26 +50,26 @@ package body Sem_Names is
-- Avoid error storm.
return;
end if;
- Error_Msg_Sem ("can't resolve overload for " & Disp_Node (Expr), Expr);
+ Error_Msg_Sem (+Expr, "can't resolve overload for %n", +Expr);
end Error_Overload;
procedure Disp_Overload_List (List : Iir_List; Loc : Iir)
is
El : Iir;
begin
- Error_Msg_Sem ("possible interpretations are:", Loc);
+ Error_Msg_Sem (+Loc, "possible interpretations are:", Cont => True);
for I in Natural loop
El := Get_Nth_Element (List, I);
exit when El = Null_Iir;
case Get_Kind (El) is
when Iir_Kind_Function_Declaration
| Iir_Kind_Procedure_Declaration =>
- Error_Msg_Sem (Disp_Subprg (El), El);
+ Error_Msg_Sem (+El, Disp_Subprg (El));
when Iir_Kind_Function_Call =>
El := Get_Implementation (El);
- Error_Msg_Sem (Disp_Subprg (El), El);
+ Error_Msg_Sem (+El, Disp_Subprg (El));
when others =>
- Error_Msg_Sem (Disp_Node (El), El);
+ Error_Msg_Sem (+El, "%n", +El);
end case;
end loop;
end Disp_Overload_List;
@@ -534,8 +534,8 @@ package body Sem_Names is
then
if Get_Kind (Get_Type (Obj)) /= Iir_Kind_Protected_Type_Declaration
then
- Error_Msg_Sem ("type of the prefix should be a protected type",
- Prefix);
+ Error_Msg_Sem
+ (+Prefix, "type of the prefix should be a protected type");
return;
end if;
Set_Method_Object (Call, Obj);
@@ -685,7 +685,7 @@ package body Sem_Names is
-- LRM93 �6.5: the prefix of an indexed name must be appropriate
-- for an array type.
if Get_Kind (Prefix_Bt) /= Iir_Kind_Array_Type_Definition then
- Error_Msg_Sem ("slice can only be applied to an array", Name);
+ Error_Msg_Sem (+Name, "slice can only be applied to an array");
return;
end if;
@@ -694,7 +694,7 @@ package body Sem_Names is
-- one-dimensionnal array object.
Index_List := Get_Index_Subtype_List (Prefix_Type);
if Get_Nbr_Elements (Index_List) /= 1 then
- Error_Msg_Sem ("slice prefix must be an unidimensional array", Name);
+ Error_Msg_Sem (+Name, "slice prefix must be an unidimensional array");
return;
end if;
@@ -738,7 +738,7 @@ package body Sem_Names is
"direction mismatch results in a null slice");
end if;
- Error_Msg_Sem ("direction of the range mismatch", Name);
+ Error_Msg_Sem (+Name, "direction of the range mismatch");
end if;
-- LRM93 �7.4.1
@@ -842,7 +842,7 @@ package body Sem_Names is
Finish_Sem_Function_Call (Expr, Name);
return Expr;
else
- Error_Msg_Sem (Disp_Node (Expr) & " requires parameters", Name);
+ Error_Msg_Sem (+Name, "%n requires parameters", +Expr);
Set_Type (Name, Get_Type (Expr));
Set_Expr_Staticness (Name, None);
Set_Named_Entity (Name, Create_Error_Expr (Expr, Get_Type (Expr)));
@@ -874,14 +874,14 @@ package body Sem_Names is
Atype := Get_Type (Atype);
else
Error_Msg_Sem
- ("a type mark must denote a type or a subtype", Name);
+ (+Name, "a type mark must denote a type or a subtype");
Atype := Create_Error_Type (Atype);
Set_Named_Entity (Res, Atype);
end if;
else
if Get_Kind (Res) /= Iir_Kind_Error then
Error_Msg_Sem
- ("a type mark must be a simple or expanded name", Name);
+ (+Name, "a type mark must be a simple or expanded name");
end if;
Res := Name;
Atype := Create_Error_Type (Name);
@@ -891,7 +891,7 @@ package body Sem_Names is
if not Incomplete then
if Get_Kind (Atype) = Iir_Kind_Incomplete_Type_Definition then
Error_Msg_Sem
- ("invalid use of an incomplete type definition", Name);
+ (+Name, "invalid use of an incomplete type definition");
Atype := Create_Error_Type (Name);
Set_Named_Entity (Res, Atype);
end if;
@@ -924,7 +924,7 @@ package body Sem_Names is
Parameter := Universal_Integer_One;
else
if Get_Expr_Staticness (Parameter) /= Locally then
- Error_Msg_Sem ("parameter must be locally static", Parameter);
+ Error_Msg_Sem (+Parameter, "parameter must be locally static");
Parameter := Universal_Integer_One;
end if;
end if;
@@ -952,7 +952,7 @@ package body Sem_Names is
Dim := Get_Value (Parameter);
if Dim < 1 or else Dim > Iir_Int64 (Get_Nbr_Elements (Indexes_List))
then
- Error_Msg_Sem ("parameter value out of bound", Attr);
+ Error_Msg_Sem (+Attr, "parameter value out of bound");
Parameter := Universal_Integer_One;
Dim := 1;
end if;
@@ -1024,7 +1024,7 @@ package body Sem_Names is
Param_Type : Iir;
begin
if Param = Null_Iir then
- Error_Msg_Sem (Disp_Node (Attr) & " requires a parameter", Attr);
+ Error_Msg_Sem (+Attr, "%n requires a parameter", +Attr);
return;
end if;
@@ -1057,7 +1057,7 @@ package body Sem_Names is
if Get_Kind (Get_Base_Type (Param_Type))
/= Iir_Kind_Integer_Type_Definition
then
- Error_Msg_Sem ("parameter must be an integer", Attr);
+ Error_Msg_Sem (+Attr, "parameter must be an integer");
return;
end if;
Parameter := Param;
@@ -1109,7 +1109,7 @@ package body Sem_Names is
return;
end if;
if Get_Kind (Attr) = Iir_Kind_Transaction_Attribute then
- Error_Msg_Sem ("'transaction does not allow a parameter", Attr);
+ Error_Msg_Sem (+Attr, "'transaction does not allow a parameter");
else
Param := Sem_Expression (Parameter, Time_Subtype_Definition);
if Param /= Null_Iir then
@@ -1118,7 +1118,7 @@ package body Sem_Names is
-- to a nonnegative value.]
if Get_Expr_Staticness (Param) = None then
Error_Msg_Sem
- ("parameter of signal attribute must be static", Param);
+ (+Param, "parameter of signal attribute must be static");
end if;
Set_Parameter (Attr, Param);
end if;
@@ -1227,8 +1227,7 @@ package body Sem_Names is
| Iir_Kind_Aggregate
| Iir_Kind_String_Literal8 =>
Error_Msg_Sem
- (Disp_Node (Actual) & " cannot be a type conversion operand",
- Actual);
+ (+Actual, "%n cannot be a type conversion operand", +Actual);
return Conv;
when others =>
-- LRM93 7.3.5
@@ -1241,8 +1240,7 @@ package body Sem_Names is
end if;
if Get_Kind (Expr) in Iir_Kinds_Allocator then
Error_Msg_Sem
- (Disp_Node (Expr) & " cannot be a type conversion operand",
- Expr);
+ (+Expr, "%n cannot be a type conversion operand", +Expr);
end if;
Set_Expression (Conv, Expr);
end case;
@@ -1276,8 +1274,8 @@ package body Sem_Names is
then
-- FIXME: should explain why the types are not closely related.
Error_Msg_Sem
- ("conversion not allowed between not closely related types",
- Conv);
+ (+Conv,
+ "conversion not allowed between not closely related types");
-- Avoid error storm in evaluation.
Set_Expr_Staticness (Conv, None);
else
@@ -1310,8 +1308,7 @@ package body Sem_Names is
is
begin
Error_Msg_Sem_Relaxed
- (Loc, "reference to " & Disp_Node (Obj) & " violate pure rule for "
- & Disp_Node (Subprg));
+ (Loc, "reference to %n violate pure rule for %n", (+Obj, +Subprg));
end Error_Pure;
Subprg : constant Iir := Sem_Stmts.Get_Current_Subprogram;
@@ -1684,8 +1681,7 @@ package body Sem_Names is
if not Valid_Interpretation (Interpretation) then
-- Unknown name.
if not Soft then
- Error_Msg_Sem
- ("no declaration for """ & Image_Identifier (Name) & """", Name);
+ Error_Msg_Sem (+Name, "no declaration for %i", +Name);
end if;
Res := Error_Mark;
elsif not Valid_Interpretation (Get_Next_Interpretation (Interpretation))
@@ -1710,8 +1706,7 @@ package body Sem_Names is
Res := Get_Declaration (Get_Under_Interpretation (Id));
else
if not Soft then
- Error_Msg_Sem
- (Disp_Node (Res) & " is not visible here", Name);
+ Error_Msg_Sem (+Name, "%n is not visible here", +Res);
end if;
-- Even if a named entity was found, return an error_mark.
-- Indeed, the named entity found is certainly the one being
@@ -1847,11 +1842,10 @@ package body Sem_Names is
end if;
if Get_Kind (Base_Type) /= Iir_Kind_Record_Type_Definition then
Error_Msg_Sem
- (Disp_Node (Prefix) & " does not designate a record", Name);
+ (+Name, "%n does not designate a record", +Prefix);
else
Error_Msg_Sem
- ("no element """ & Name_Table.Image (Suffix)
- & """ in " & Disp_Node (Base_Type), Name);
+ (+Name, "no element %i in %n", (+Suffix, +Base_Type));
end if;
end Error_Selected_Element;
@@ -1884,9 +1878,7 @@ package body Sem_Names is
procedure Error_Protected_Item (Prot_Type : Iir) is
begin
- Error_Msg_Sem
- ("no method " & Name_Table.Image (Suffix) & " in "
- & Disp_Node (Prot_Type), Name);
+ Error_Msg_Sem (+Name, "no method %i in %n", (+Suffix, +Prot_Type));
end Error_Protected_Item;
-- Emit an error message if unit is not found in library LIB.
@@ -1894,9 +1886,7 @@ package body Sem_Names is
is
use Std_Names;
begin
- Error_Msg_Sem
- ("unit """ & Name_Table.Image (Suffix)
- & """ not found in " & Disp_Node (Lib), Name);
+ Error_Msg_Sem (+Name, "unit %i not found in %n", (+Suffix, +Lib));
-- Give an advice for common synopsys packages.
if Get_Identifier (Lib) = Name_Ieee then
@@ -1905,8 +1895,8 @@ package body Sem_Names is
or else Suffix = Name_Std_Logic_Unsigned
then
Error_Msg_Sem
- (" (use --ieee=synopsys for non-standard synopsys packages)",
- Name);
+ (+Name,
+ " (use --ieee=synopsys for non-standard synopsys packages)");
end if;
end if;
end Error_Unit_Not_Found;
@@ -1963,8 +1953,8 @@ package body Sem_Names is
end if;
end;
if Res = Null_Iir then
- Error_Msg_Sem ("no suffix """ & Name_Table.Image (Suffix)
- & """ for overloaded selected name", Name);
+ Error_Msg_Sem
+ (+Name, "no suffix %i for overloaded selected name", +Suffix);
end if;
when Iir_Kind_Library_Declaration =>
-- LRM93 6.3
@@ -2015,8 +2005,7 @@ package body Sem_Names is
if Res = Null_Iir then
Error_Msg_Sem
- ("no declaration for """ & Name_Table.Image (Suffix)
- & """ in " & Disp_Node (Prefix), Name);
+ (+Name, "no declaration for %i in %n", (+Suffix, +Prefix));
else
-- LRM93 �6.3
-- This form of expanded name is only allowed within the
@@ -2027,8 +2016,8 @@ package body Sem_Names is
and then not Get_Is_Within_Flag (Prefix)
then
Error_Msg_Sem
- ("this expanded name is only allowed within the construct",
- Prefix_Loc);
+ (+Prefix_Loc,
+ "an expanded name is only allowed within the construct");
-- Hum, keep res.
end if;
end if;
@@ -2066,7 +2055,7 @@ package body Sem_Names is
| Iir_Kind_Component_Instantiation_Statement
| Iir_Kind_Slice_Name =>
Error_Msg_Sem
- (Disp_Node (Prefix) & " cannot be selected by name", Prefix_Loc);
+ (+Prefix_Loc, "%n cannot be selected by name", +Prefix);
when others =>
Error_Kind ("sem_selected_name(2)", Prefix);
@@ -2154,7 +2143,7 @@ package body Sem_Names is
Actual := Get_One_Actual (Get_Association_Chain (Name));
if Actual = Null_Iir then
- Error_Msg_Sem ("only one index specification is allowed", Name);
+ Error_Msg_Sem (+Name, "only one index specification is allowed");
return Null_Iir;
end if;
case Get_Kind (Actual) is
@@ -2178,7 +2167,7 @@ package body Sem_Names is
end if;
Check_Read (Actual);
if Get_Expr_Staticness (Actual) < Globally then
- Error_Msg_Sem ("index must be a static expression", Name);
+ Error_Msg_Sem (+Name, "index must be a static expression");
end if;
Set_Index_List (Res, Create_Iir_List);
Append_Element (Get_Index_List (Res), Actual);
@@ -2188,7 +2177,7 @@ package body Sem_Names is
return Null_Iir;
end if;
if Get_Expr_Staticness (Actual) < Globally then
- Error_Msg_Sem ("index must be a static expression", Name);
+ Error_Msg_Sem (+Name, "index must be a static expression");
end if;
Set_Suffix (Res, Actual);
when others =>
@@ -2218,7 +2207,7 @@ package body Sem_Names is
begin
if Slice_Index_Kind = Iir_Kind_Error then
if Finish then
- Error_Msg_Sem ("prefix is not a function name", Name);
+ Error_Msg_Sem (+Name, "prefix is not a function name");
end if;
-- No way.
return Null_Iir;
@@ -2230,8 +2219,8 @@ package body Sem_Names is
and then Get_Kind (Sub_Name) /= Iir_Kind_Function_Declaration
then
if Finish then
- Error_Msg_Sem ("prefix is not an array value (found "
- & Disp_Node (Sub_Name) & ")", Name);
+ Error_Msg_Sem
+ (+Name, "prefix is not an array value (found %n)", +Sub_Name);
end if;
return Null_Iir;
end if;
@@ -2247,7 +2236,7 @@ package body Sem_Names is
if Get_Kind (Base_Type) /= Iir_Kind_Array_Type_Definition then
if Finish then
- Error_Msg_Sem ("type of prefix is not an array", Name);
+ Error_Msg_Sem (+Name, "type of prefix is not an array");
end if;
return Null_Iir;
end if;
@@ -2256,7 +2245,7 @@ package body Sem_Names is
then
if Finish then
Error_Msg_Sem
- ("number of indexes mismatches array dimension", Name);
+ (+Name, "number of indexes mismatches array dimension");
end if;
return Null_Iir;
end if;
@@ -2294,7 +2283,7 @@ package body Sem_Names is
if not Maybe_Function_Call (Sub_Name) then
if Finish then
- Error_Msg_Sem ("missing parameters for function call", Name);
+ Error_Msg_Sem (+Name, "missing parameters for function call");
end if;
return Null_Iir;
end if;
@@ -2370,8 +2359,7 @@ package body Sem_Names is
is
Match : Compatibility_Level;
begin
- Error_Msg_Sem
- ("cannot match " & Disp_Node (Prefix) & " with actuals", Name);
+ Error_Msg_Sem (+Name, "cannot match %n with actuals", +Prefix);
-- Display error message.
Sem_Association_Chain
(Get_Interface_Declaration_Chain (Spec),
@@ -2402,7 +2390,7 @@ package body Sem_Names is
if Actual = Null_Iir then
-- More than one actual. Keep only the first.
Error_Msg_Sem
- ("type conversion allows only one expression", Name);
+ (+Name, "type conversion allows only one expression");
end if;
-- This is certainly the easiest case: the prefix is not overloaded,
@@ -2463,8 +2451,8 @@ package body Sem_Names is
end;
if Res = Null_Iir then
Error_Msg_Sem
- ("no overloaded function found matching "
- & Disp_Node (Prefix_Name), Name);
+ (+Name, "no overloaded function found matching %n",
+ +Prefix_Name);
end if;
when Iir_Kind_Function_Declaration =>
Sem_Parenthesis_Function (Prefix);
@@ -2488,7 +2476,7 @@ package body Sem_Names is
Finish_Sem_Array_Attribute (Prefix_Name, Prefix, Actual);
Set_Named_Entity (Name, Prefix);
else
- Error_Msg_Sem ("bad attribute parameter", Name);
+ Error_Msg_Sem (+Name, "bad attribute parameter");
Set_Named_Entity (Name, Error_Mark);
end if;
return;
@@ -2506,7 +2494,7 @@ package body Sem_Names is
Set_Named_Entity (Name, Prefix);
return;
else
- Error_Msg_Sem ("bad attribute parameter", Name);
+ Error_Msg_Sem (+Name, "bad attribute parameter");
Set_Named_Entity (Name, Error_Mark);
return;
end if;
@@ -2514,7 +2502,7 @@ package body Sem_Names is
when Iir_Kind_Type_Declaration
| Iir_Kind_Subtype_Declaration =>
Error_Msg_Sem
- ("subprogram name is a type mark (missing apostrophe)", Name);
+ (+Name, "subprogram name is a type mark (missing apostrophe)");
when Iir_Kind_Stable_Attribute
| Iir_Kind_Quiet_Attribute
@@ -2523,19 +2511,18 @@ package body Sem_Names is
Finish_Sem_Signal_Attribute (Prefix_Name, Prefix, Actual);
Set_Named_Entity (Name, Prefix);
else
- Error_Msg_Sem ("bad attribute parameter", Name);
+ Error_Msg_Sem (+Name, "bad attribute parameter");
Set_Named_Entity (Name, Error_Mark);
end if;
return;
when Iir_Kind_Procedure_Declaration =>
- Error_Msg_Sem ("function name is a procedure", Name);
+ Error_Msg_Sem (+Name, "function name is a procedure");
when Iir_Kinds_Process_Statement
| Iir_Kind_Component_Declaration
| Iir_Kind_Type_Conversion =>
- Error_Msg_Sem
- (Disp_Node (Prefix) & " cannot be indexed or sliced", Name);
+ Error_Msg_Sem (+Name, "%n cannot be indexed or sliced", +Prefix);
Res := Null_Iir;
when Iir_Kind_Psl_Declaration
@@ -2543,7 +2530,7 @@ package body Sem_Names is
Res := Sem_Psl.Sem_Psl_Name (Name);
when Iir_Kinds_Library_Unit_Declaration =>
- Error_Msg_Sem ("function name is a design unit", Name);
+ Error_Msg_Sem (+Name, "function name is a design unit");
when Iir_Kind_Error =>
-- Continue with the error.
@@ -2630,7 +2617,7 @@ package body Sem_Names is
Error_Kind ("sem_selected_by_all_name", Prefix);
end case;
if Res = Null_Iir then
- Error_Msg_Sem ("prefix type is not an access type", Name);
+ Error_Msg_Sem (+Name, "prefix type is not an access type");
Res := Error_Mark;
end if;
Set_Named_Entity (Name, Res);
@@ -2659,7 +2646,7 @@ package body Sem_Names is
end if;
when others =>
Error_Msg_Sem
- ("prefix of 'base attribute must be a type or a subtype", Attr);
+ (+Attr, "prefix of 'base attribute must be a type or a subtype");
return Error_Mark;
end case;
Res := Create_Iir (Iir_Kind_Base_Attribute);
@@ -2695,12 +2682,12 @@ package body Sem_Names is
| Iir_Kind_Selected_Name
| Iir_Kind_Indexed_Name
| Iir_Kind_Slice_Name =>
- Error_Msg_Sem ("prefix of user defined attribute cannot be an "
- & "object subelement", Attr);
+ Error_Msg_Sem (+Attr, "prefix of user defined attribute cannot be "
+ & "an object subelement");
return Error_Mark;
when Iir_Kind_Dereference =>
- Error_Msg_Sem ("prefix of user defined attribute cannot be an "
- & "anonymous object", Attr);
+ Error_Msg_Sem (+Attr, "prefix of user defined attribute cannot be "
+ & "an anonymous object");
return Error_Mark;
when Iir_Kinds_Object_Declaration
| Iir_Kind_Type_Declaration
@@ -2722,14 +2709,13 @@ package body Sem_Names is
Attr_Id := Get_Identifier (Attr);
Value := Sem_Specs.Find_Attribute_Value (Prefix, Attr_Id);
if Value = Null_Iir then
- Error_Msg_Sem
- (Disp_Node (Prefix) & " was not annotated with attribute '"
- & Name_Table.Image (Attr_Id) & ''', Attr);
+ Error_Msg_Sem (+Attr, "%n was not annotated with attribute %i",
+ (+Prefix, +Attr_Id));
if Attr_Id = Std_Names.Name_First or Attr_Id = Std_Names.Name_Last
then
-- Nice (?) message for Ada users.
Error_Msg_Sem
- ("(you may use 'high, 'low, 'left or 'right attribute)", Attr);
+ (+Attr, "(you may use 'high, 'low, 'left or 'right attribute)");
end if;
return Error_Mark;
end if;
@@ -2764,8 +2750,8 @@ package body Sem_Names is
when Iir_Kind_Base_Attribute =>
Prefix_Type := Get_Type (Prefix);
when others =>
- Error_Msg_Sem ("prefix of '" & Name_Table.Image (Id)
- & " attribute must be a type", Attr);
+ Error_Msg_Sem
+ (+Attr, "prefix of %i attribute must be a type", +Id);
return Error_Mark;
end case;
@@ -2775,11 +2761,11 @@ package body Sem_Names is
if Get_Kind (Prefix_Type) not in Iir_Kinds_Scalar_Type_Definition
then
Error_Msg_Sem
- ("prefix of '" & Name_Table.Image (Id)
- & " attribute must be a scalar type", Attr);
+ (+Attr, "prefix of %i attribute must be a scalar type",
+ (1 => +Id), Cont => True);
Error_Msg_Sem
- ("found " & Disp_Node (Prefix_Type)
- & " defined at " & Disp_Location (Prefix_Type), Attr);
+ (+Attr, "found %n defined at %l",
+ (+Prefix_Type, +Prefix_Type));
return Error_Mark;
end if;
when others =>
@@ -2790,11 +2776,12 @@ package body Sem_Names is
null;
when others =>
Error_Msg_Sem
- ("prefix of '" & Name_Table.Image (Id)
- & " attribute must be discrete or physical type", Attr);
+ (+Attr, "prefix of %i"
+ & " attribute must be discrete or physical type",
+ (1 => +Id), Cont => True);
Error_Msg_Sem
- ("found " & Disp_Node (Prefix_Type)
- & " defined at " & Disp_Location (Prefix_Type), Attr);
+ (+Attr, "found %n defined at %l",
+ (+Prefix_Type, +Prefix_Type));
return Error_Mark;
end case;
end case;
@@ -2880,12 +2867,11 @@ package body Sem_Names is
when Name_Range
| Name_Reverse_Range =>
Error_Msg_Sem
- ("prefix of range attribute must be an array type or object",
- Attr);
+ (+Attr,
+ "prefix of range attribute must be an array type or object");
return Error_Mark;
when others =>
- Error_Msg_Sem ("Attribute '" & Name_Table.Image (Id)
- & " not valid on this type", Attr);
+ Error_Msg_Sem (+Attr, "attribute %i not valid on this type", +Id);
return Error_Mark;
end case;
Location_Copy (Res, Attr);
@@ -2982,7 +2968,7 @@ package body Sem_Names is
when Iir_Kinds_Array_Type_Definition =>
null;
when others =>
- Error_Msg_Sem ("object prefix must be an array", Attr);
+ Error_Msg_Sem (+Attr, "object prefix must be an array");
return Error_Mark;
end case;
when Iir_Kind_Subtype_Declaration
@@ -2990,7 +2976,7 @@ package body Sem_Names is
| Iir_Kind_Base_Attribute =>
Prefix_Type := Get_Type (Prefix);
if not Is_Fully_Constrained_Type (Prefix_Type) then
- Error_Msg_Sem ("prefix type is not constrained", Attr);
+ Error_Msg_Sem (+Attr, "prefix type is not constrained");
-- We continue using the unconstrained array type.
-- At least, this type is valid; and even if the array was
-- constrained, the base type would be the same.
@@ -3002,13 +2988,12 @@ package body Sem_Names is
Prefix_Type := Get_Type (Prefix);
when Iir_Kind_Process_Statement =>
Error_Msg_Sem
- (Disp_Node (Prefix) & " is not an appropriate prefix for '"
- & Name_Table.Image (Get_Identifier (Attr))
- & " attribute",
- Attr);
+ (+Attr, "%n is not an appropriate prefix for %i attribute",
+ (+Prefix, +Attr));
return Error_Mark;
when others =>
- Error_Msg_Sem ("prefix must denote an array object or type", Attr);
+ Error_Msg_Sem
+ (+Attr, "prefix must denote an array object or type");
return Error_Mark;
end case;
@@ -3019,11 +3004,8 @@ package body Sem_Names is
when Iir_Kinds_Array_Type_Definition =>
null;
when others =>
- Error_Msg_Sem
- ("prefix of '"
- & Name_Table.Image (Get_Identifier (Attr))
- & " attribute must denote a constrained array subtype",
- Attr);
+ Error_Msg_Sem (+Attr, "prefix of %i attribute must denote a "
+ & "constrained array subtype", +Attr);
return Error_Mark;
end case;
@@ -3091,8 +3073,7 @@ package body Sem_Names is
when Iir_Kind_Function_Declaration
| Iir_Kind_Procedure_Declaration =>
Error_Msg_Sem
- ("'" & Name_Table.Image (Get_Identifier (Attr)) &
- " is not allowed for a signal parameter", Attr);
+ (+Attr, "%i is not allowed for a signal parameter", +Attr);
when others =>
null;
end case;
@@ -3118,9 +3099,7 @@ package body Sem_Names is
null;
when others =>
Error_Msg_Sem
- ("prefix of '"
- & Name_Table.Image (Get_Identifier (Attr))
- & " attribute must denote a signal", Attr);
+ (+Attr, "prefix of %i attribute must denote a signal", +Attr);
return Error_Mark;
end case;
case Get_Identifier (Attr) is
@@ -3202,8 +3181,8 @@ package body Sem_Names is
-- FIXME: complete checks.
if Get_Current_Concurrent_Statement = Null_Iir then
Error_Msg_Sem
- ("'driving or 'driving_value is available only within a "
- & "concurrent statement", Attr);
+ (+Attr, "'driving or 'driving_value is available only "
+ & "within a concurrent statement");
else
case Get_Kind (Get_Current_Concurrent_Statement) is
when Iir_Kinds_Process_Statement
@@ -3213,8 +3192,8 @@ package body Sem_Names is
null;
when others =>
Error_Msg_Sem
- ("'driving or 'driving_value not available within "
- & "this concurrent statement", Attr);
+ (+Attr, "'driving or 'driving_value not available "
+ & "within this concurrent statement");
end case;
end if;
@@ -3229,12 +3208,12 @@ package body Sem_Names is
null;
when others =>
Error_Msg_Sem
- ("mode of 'driving or 'driving_value prefix must "
- & "be out, inout or buffer", Attr);
+ (+Attr, "mode of 'driving or 'driving_value prefix "
+ & "must be out, inout or buffer");
end case;
when others =>
Error_Msg_Sem
- ("bad prefix for 'driving or 'driving_value", Attr);
+ (+Attr, "bad prefix for 'driving or 'driving_value");
end case;
when others =>
null;
@@ -3333,12 +3312,11 @@ package body Sem_Names is
= Iir_Kind_Component_Declaration
then
Error_Msg_Sem
- ("local ports or generics of a component cannot be a prefix",
- Attr);
+ (+Attr,
+ "local ports or generics of a component cannot be a prefix");
end if;
when others =>
- Error_Msg_Sem (Disp_Node (Prefix) & " is not a named entity",
- Attr);
+ Error_Msg_Sem (+Attr, "%n is not a named entity", +Prefix);
end case;
case Get_Identifier (Attr) is
@@ -3428,7 +3406,7 @@ package body Sem_Names is
if Get_Kind (Prefix) = Iir_Kind_Overload_List then
-- FIXME: this should be allowed.
- Error_Msg_Sem ("prefix of attribute is overloaded", Attr);
+ Error_Msg_Sem (+Attr, "prefix of attribute is overloaded");
Set_Named_Entity (Attr, Error_Mark);
return;
end if;
@@ -3658,8 +3636,7 @@ package body Sem_Names is
Expr := Remove_Procedures_From_List (Expr);
Set_Named_Entity (Name, Expr);
if Expr = Null_Iir then
- Error_Msg_Sem ("procedure name " & Disp_Node (Name)
- & " cannot be used as expression", Name);
+ Error_Msg_Sem (+Name, "%n cannot be used as expression", +Name);
return Create_Error_Expr (Name, A_Type);
end if;
@@ -3825,8 +3802,7 @@ package body Sem_Names is
end if;
return Expr;
when others =>
- Error_Msg_Sem ("name " & Disp_Node (Name)
- & " doesn't denote a range", Name);
+ Error_Msg_Sem (+Name, "%n doesn't denote a range", +Name);
return Error_Mark;
end case;
end Name_To_Range;
@@ -3926,11 +3902,10 @@ package body Sem_Names is
Ent : constant Iir := Get_Named_Entity (Name);
begin
if Is_Error (Ent) then
- Error_Msg_Sem (Class_Name & " name expected", Name);
+ Error_Msg_Sem (+Name, Class_Name & " name expected");
else
- Error_Msg_Sem
- (Class_Name & " name expected, found "
- & Disp_Node (Get_Named_Entity (Name)), Name);
+ Error_Msg_Sem (+Name, Class_Name & " name expected, found %n",
+ +Get_Named_Entity (Name));
end if;
end Error_Class_Match;
end Sem_Names;
diff --git a/src/vhdl/sem_psl.adb b/src/vhdl/sem_psl.adb
index 841a0dca7..bdcc35112 100644
--- a/src/vhdl/sem_psl.adb
+++ b/src/vhdl/sem_psl.adb
@@ -181,7 +181,7 @@ package body Sem_Psl is
Set_Location (Res, Get_Location (N));
Set_Declaration (Res, Decl);
if Get_Parameter_List (Decl) /= Null_Node then
- Error_Msg_Sem ("no actual for instantiation", Res);
+ Error_Msg_Sem (+Res, "no actual for instantiation");
end if;
Free_Node (N);
Free_Iir (Expr);
@@ -208,7 +208,7 @@ package body Sem_Psl is
end if;
Free_Node (N);
if not Is_Psl_Bool_Expr (Expr) then
- Error_Msg_Sem ("type of expression must be boolean", Expr);
+ Error_Msg_Sem (+Expr, "type of expression must be boolean");
return PSL.Hash.Get_PSL_Node (HDL_Node (Expr));
else
return Convert_Bool (Expr);
@@ -301,7 +301,7 @@ package body Sem_Psl is
null;
when N_Property_Instance =>
Error_Msg_Sem
- ("property instance not allowed in PSL sequence", Res);
+ (+Res, "property instance not allowed in PSL sequence");
when others =>
Error_Kind ("psl.sem_sequence.hdl", Res);
end case;
@@ -336,7 +336,7 @@ package body Sem_Psl is
Res := Sem_Boolean (Get_Boolean (Prop));
Set_Boolean (Prop, Res);
if not Top then
- Error_Msg_Sem ("inner clock event not supported", Prop);
+ Error_Msg_Sem (+Prop, "inner clock event not supported");
end if;
return Prop;
when N_Abort =>
@@ -400,8 +400,8 @@ package body Sem_Psl is
if Decl /= Null_Node
and then Get_Global_Clock (Decl) /= Null_Node
then
- Error_Msg_Sem ("property instance already has a clock",
- Prop);
+ Error_Msg_Sem
+ (+Prop, "property instance already has a clock");
end if;
end;
end if;
@@ -603,7 +603,7 @@ package body Sem_Psl is
Extract_Clock (Prop, Clk);
if Clk = Null_Node then
if Current_Psl_Default_Clock = Null_Iir then
- Error_Msg_Sem ("no clock for PSL directive", Stmt);
+ Error_Msg_Sem (+Stmt, "no clock for PSL directive");
Clk := Null_Node;
else
Clk := Get_Psl_Boolean (Current_Psl_Default_Clock);
@@ -670,9 +670,11 @@ package body Sem_Psl is
and then Get_Parent (Current_Psl_Default_Clock) = Get_Parent (Stmt)
then
Error_Msg_Sem
- ("redeclaration of PSL default clock in the same region", Stmt);
- Error_Msg_Sem (" (previous default clock declaration)",
- Current_Psl_Default_Clock);
+ (+Stmt, "redeclaration of PSL default clock in the same region",
+ Cont => True);
+ Error_Msg_Sem
+ (+Current_Psl_Default_Clock,
+ " (previous default clock declaration)");
end if;
Expr := Sem_Boolean (Get_Psl_Boolean (Stmt));
Set_Psl_Boolean (Stmt, Expr);
@@ -703,7 +705,7 @@ package body Sem_Psl is
when N_Endpoint_Declaration =>
Res := Create_Node (N_Endpoint_Instance);
when others =>
- Error_Msg_Sem ("can only instantiate a psl declaration", Name);
+ Error_Msg_Sem (+Name, "can only instantiate a psl declaration");
return Null_Iir;
end case;
Set_Declaration (Res, Decl);
@@ -714,14 +716,14 @@ package body Sem_Psl is
while Formal /= Null_Node loop
if Assoc = Null_Iir then
- Error_Msg_Sem ("not enough association", Name);
+ Error_Msg_Sem (+Name, "not enough association");
exit;
end if;
if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Expression then
Error_Msg_Sem
- ("open or individual association not allowed", Assoc);
+ (+Assoc, "open or individual association not allowed");
elsif Get_Formal (Assoc) /= Null_Iir then
- Error_Msg_Sem ("named association not allowed in psl", Assoc);
+ Error_Msg_Sem (+Assoc, "named association not allowed in psl");
else
Actual := Get_Actual (Assoc);
-- FIXME: currently only boolean are parsed.
@@ -747,7 +749,7 @@ package body Sem_Psl is
Assoc := Get_Chain (Assoc);
end loop;
if Assoc /= Null_Iir then
- Error_Msg_Sem ("too many association", Name);
+ Error_Msg_Sem (+Name, "too many association");
end if;
Res2 := Create_Iir (Iir_Kind_Psl_Expression);
diff --git a/src/vhdl/sem_scopes.adb b/src/vhdl/sem_scopes.adb
index 45278e385..af4456b15 100644
--- a/src/vhdl/sem_scopes.adb
+++ b/src/vhdl/sem_scopes.adb
@@ -771,9 +771,8 @@ package body Sem_Scopes is
if not (Is_Decl_Implicit xor Is_Current_Decl_Implicit)
then
Error_Msg_Sem
- ("redeclaration of " & Disp_Node (Current_Decl) &
- " defined at " & Disp_Location (Current_Decl),
- Decl);
+ (+Decl, "redeclaration of %n defined at %l",
+ (+Current_Decl, +Current_Decl));
return;
end if;
@@ -900,12 +899,11 @@ package body Sem_Scopes is
-- declarative region must not be homographs,
-- FIXME: unless one of them is the implicit declaration of a
-- predefined operation.
- Error_Msg_Sem ("identifier '" & Name_Table.Image (Ident)
- & "' already used for a declaration",
- Decl);
Error_Msg_Sem
- ("previous declaration: " & Disp_Node (Current_Decl),
- Current_Decl);
+ (+Decl, "identifier %i already used for a declaration",
+ (1 => +Ident), Cont => True);
+ Error_Msg_Sem
+ (+Current_Decl, "previous declaration: %n", +Current_Decl);
return;
end if;
end if;
diff --git a/src/vhdl/sem_specs.adb b/src/vhdl/sem_specs.adb
index 66aa7e17f..7eaa78c34 100644
--- a/src/vhdl/sem_specs.adb
+++ b/src/vhdl/sem_specs.adb
@@ -201,9 +201,8 @@ package body Sem_Specs is
-- denoted by the entity class.
if Get_Entity_Class_Kind (Decl) /= Get_Entity_Class (Attr) then
if Check_Class then
- Error_Msg_Sem (Disp_Node (Decl) & " is not of class '"
- & Tokens.Image (Get_Entity_Class (Attr)) & ''',
- Attr);
+ Error_Msg_Sem (+Attr, "%n is not of class %t",
+ (+Decl, +Get_Entity_Class (Attr)));
if Get_Kind (Decl) = Iir_Kind_Subtype_Declaration
and then Get_Entity_Class (Attr) = Tok_Type
and then Get_Type (Decl) /= Null_Iir
@@ -215,9 +214,9 @@ package body Sem_Specs is
-- The type declaration declares an anonymous type
-- and a named subtype.
Error_Msg_Sem
- ("'" & Image_Identifier (Decl)
- & "' declares both an anonymous type and a named subtype",
- Decl);
+ (+Decl,
+ "%i declares both an anonymous type and a named subtype",
+ +Decl);
end if;
end if;
return;
@@ -234,8 +233,8 @@ package body Sem_Specs is
| Tok_Configuration
| Tok_Package =>
if Get_Design_Unit (Decl) /= Get_Current_Design_Unit then
- Error_Msg_Sem (Disp_Node (Attr) & " must appear immediatly "
- & "within " & Disp_Node (Decl), Attr);
+ Error_Msg_Sem (+Attr, "%n must appear immediatly within %n",
+ (+Attr, +Decl));
return;
end if;
when others =>
@@ -273,18 +272,17 @@ package body Sem_Specs is
end if;
if Check_Defined then
Error_Msg_Sem
- (Disp_Node (Decl) & " has already " & Disp_Node (Attr),
- Attr);
- Error_Msg_Sem ("previous attribute specification at "
- & Disp_Location (El), Attr);
+ (+Attr, "%n has already %n", (+Decl, +Attr),
+ Cont => True);
+ Error_Msg_Sem
+ (+Attr, "previous attribute specification at %l", +El);
end if;
return;
elsif Get_Identifier (El_Attr) = Get_Identifier (Attr_Decl) then
+ Error_Msg_Sem (+Attr, "%n is already decorated with an %n",
+ (+Decl, +El_Attr), Cont => True);
Error_Msg_Sem
- (Disp_Node (Decl) & " is already decorated with an "
- & Disp_Node (El_Attr), Attr);
- Error_Msg_Sem
- ("(previous attribute specification was here)", El);
+ (+El, "(previous attribute specification was here)");
return;
end if;
end;
@@ -344,8 +342,8 @@ package body Sem_Specs is
when others =>
Error_Msg_Sem
- ("'FOREIGN allowed only for architectures and subprograms",
- Attr);
+ (+Attr,
+ "'FOREIGN allowed only for architectures and subprograms");
return;
end case;
@@ -393,8 +391,7 @@ package body Sem_Specs is
Xref_Ref (Name, Ent);
end if;
if Get_Visible_Flag (Ent) = False then
- Error_Msg_Sem
- (Disp_Node (Ent) & " is not yet visible", Attr);
+ Error_Msg_Sem (+Attr, "%n is not yet visible", +Ent);
else
Attribute_A_Decl (Decl, Attr, Is_Designators, Check_Defined);
return True;
@@ -439,8 +436,7 @@ package body Sem_Specs is
and then Base /= Strip_Denoting_Name (Decl)
then
Error_Msg_Sem
- (Disp_Node (Ent) & " does not denote the entire object",
- Attr);
+ (+Attr, "%n does not denote the entire object", +Ent);
end if;
Res := Res or Applied;
end;
@@ -676,7 +672,7 @@ package body Sem_Specs is
Append_Element (List, Name);
when others =>
Error_Msg_Sem
- ("entity tag must denote a subprogram or a literal", Sig);
+ (+Sig, "entity tag must denote a subprogram or a literal");
end case;
end if;
Inter := Get_Next_Interpretation (Inter);
@@ -740,9 +736,9 @@ package body Sem_Specs is
| Tok_Configuration =>
if Get_Expr_Staticness (Expr) /= Locally then
Error_Msg_Sem
- ("attribute expression for "
- & Image (Get_Entity_Class (Spec))
- & " must be locally static", Spec);
+ (+Spec,
+ "attribute expression for %t must be locally static",
+ +Get_Entity_Class (Spec));
end if;
when others =>
null;
@@ -806,8 +802,7 @@ package body Sem_Specs is
-- same as that denoted by entity class.
if not Sem_Named_Entities (Scope, El, Spec, True, True) then
Error_Msg_Sem
- ("no named entities '" & Image_Identifier (El)
- & "' in declarative part", El);
+ (+El, "no named entities %i in declarative part", +El);
end if;
end if;
end loop;
@@ -887,8 +882,8 @@ package body Sem_Specs is
= Get_Identifier (Get_Attribute_Designator (Spec))
then
Error_Msg_Sem
- ("no attribute specification may follow an "
- & "all/others spec", Decl);
+ (+Decl, "no attribute specification may follow an "
+ & "all/others spec", Cont => True);
Has_Error := True;
end if;
else
@@ -897,14 +892,14 @@ package body Sem_Specs is
-- class is declared in a given declarative part following such
-- an attribute specification.
Error_Msg_Sem
- ("no named entity may follow an all/others attribute "
- & "specification", Decl);
+ (+Decl, "no named entity may follow an all/others attribute "
+ & "specification", Cont => True);
Has_Error := True;
end if;
if Has_Error then
Error_Msg_Sem
- ("(previous all/others specification for the given "
- &"entity class)", Spec);
+ (+Spec, "(previous all/others specification for the given "
+ &"entity class)");
end if;
end if;
Spec := Get_Attribute_Specification_Chain (Spec);
@@ -958,7 +953,7 @@ package body Sem_Specs is
Check_Read (Time_Expr);
Set_Expression (Dis, Time_Expr);
if Get_Expr_Staticness (Time_Expr) < Globally then
- Error_Msg_Sem ("time expression must be static", Time_Expr);
+ Error_Msg_Sem (+Time_Expr, "time expression must be static");
end if;
end if;
@@ -989,14 +984,14 @@ package body Sem_Specs is
| Iir_Kind_Interface_Signal_Declaration =>
null;
when others =>
- Error_Msg_Sem ("object must be a signal", El);
+ Error_Msg_Sem (+El, "object must be a signal");
return;
end case;
if Get_Name_Staticness (Sig) /= Locally then
- Error_Msg_Sem ("signal name must be locally static", El);
+ Error_Msg_Sem (+El, "signal name must be locally static");
end if;
if not Get_Guarded_Signal_Flag (Prefix) then
- Error_Msg_Sem ("signal must be a guarded signal", El);
+ Error_Msg_Sem (+El, "signal must be a guarded signal");
end if;
Set_Has_Disconnect_Flag (Prefix, True);
@@ -1017,7 +1012,7 @@ package body Sem_Specs is
-- FIXME: to be checked: the expression type (as set by
-- sem_expression) may be a base type instead of a type mark.
if not Is_Same_Type_Mark (Get_Type (Sig), Atype) then
- Error_Msg_Sem ("type mark and signal type mismatch", El);
+ Error_Msg_Sem (+El, "type mark and signal type mismatch");
end if;
-- LRM93 5.3
@@ -1025,7 +1020,7 @@ package body Sem_Specs is
-- enclosing the disconnection specification.
-- FIXME: todo.
elsif Get_Designated_Entity (El) /= Error_Mark then
- Error_Msg_Sem ("name must designate a signal", El);
+ Error_Msg_Sem (+El, "name must designate a signal");
end if;
end loop;
end if;
@@ -1120,7 +1115,7 @@ package body Sem_Specs is
-- An incremental binding indication must not have an entity aspect.
if Primary_Entity_Aspect /= Null_Iir then
Error_Msg_Sem
- ("entity aspect not allowed for incremental binding", Bind);
+ (+Bind, "entity aspect not allowed for incremental binding");
end if;
-- Return now in case of error.
@@ -1146,8 +1141,8 @@ package body Sem_Specs is
end if;
when Iir_Kind_Configuration_Specification =>
Error_Msg_Sem
- ("entity aspect required in a configuration specification",
- Bind);
+ (+Bind,
+ "entity aspect required in a configuration specification");
return;
when others =>
raise Internal_Error;
@@ -1167,7 +1162,7 @@ package body Sem_Specs is
or else Get_Port_Map_Aspect_Chain (Bind) /= Null_Iir
then
Error_Msg_Sem
- ("map aspect not allowed for open entity aspect", Bind);
+ (+Bind, "map aspect not allowed for open entity aspect");
return;
end if;
else
@@ -1207,10 +1202,9 @@ package body Sem_Specs is
procedure Prev_Spec_Error is
begin
Error_Msg_Sem
- (Disp_Node (Comp)
- & " is alreay bound by a configuration specification", Spec);
- Error_Msg_Sem
- ("(previous is " & Disp_Node (Prev_Spec) & ")", Prev_Spec);
+ (+Spec, "%n is alreay bound by a configuration specification",
+ (1 => +Comp), Cont => True);
+ Error_Msg_Sem (+Prev_Spec, "(previous is %n)", +Prev_Spec);
end Prev_Spec_Error;
Prev_Binding : Iir_Binding_Indication;
@@ -1226,7 +1220,7 @@ package body Sem_Specs is
if Flags.Vhdl_Std = Vhdl_87 then
Prev_Spec_Error;
Error_Msg_Sem
- ("(incremental binding is not allowed in vhdl87)", Spec);
+ (+Spec, "(incremental binding is not allowed in vhdl87)");
return;
end if;
-- Incremental binding.
@@ -1252,11 +1246,9 @@ package body Sem_Specs is
raise Internal_Error;
when Iir_Kind_Component_Configuration =>
Error_Msg_Sem
- (Disp_Node (Comp)
- & " is already bound by a component configuration",
- Spec);
- Error_Msg_Sem
- ("(previous is " & Disp_Node (Prev_Conf) & ")", Prev_Conf);
+ (+Spec, "%n is already bound by a component configuration",
+ (1 => +Comp), Cont => True);
+ Error_Msg_Sem (+Prev_Conf, "(previous is %n)", +Prev_Conf);
return;
when others =>
Error_Kind ("apply_configuration_specification(2)", Spec);
@@ -1381,16 +1373,17 @@ package body Sem_Specs is
exit when El = Null_Iir;
Inter := Sem_Scopes.Get_Interpretation (Get_Identifier (El));
if not Valid_Interpretation (Inter) then
- Error_Msg_Sem ("no component instantation with label '"
- & Image_Identifier (El) & ''', El);
+ Error_Msg_Sem
+ (+El, "no component instantation with label %i", +El);
elsif not Is_In_Current_Declarative_Region (Inter) then
-- FIXME.
- Error_Msg_Sem ("label not in block declarative part", El);
+ Error_Msg_Sem (+El, "label not in block declarative part");
else
Inst := Get_Declaration (Inter);
if Get_Kind (Inst) /= Iir_Kind_Component_Instantiation_Statement
then
- Error_Msg_Sem ("label does not denote an instantiation", El);
+ Error_Msg_Sem
+ (+El, "label does not denote an instantiation");
else
Inst_Unit := Get_Instantiated_Unit (Inst);
if Is_Entity_Instantiation (Inst)
@@ -1398,10 +1391,10 @@ package body Sem_Specs is
/= Iir_Kind_Component_Declaration)
then
Error_Msg_Sem
- ("specification does not apply to direct instantiation",
- El);
+ (+El, "specification does not apply to "
+ & "direct instantiation");
elsif Get_Named_Entity (Inst_Unit) /= Comp then
- Error_Msg_Sem ("component names mismatch", El);
+ Error_Msg_Sem (+El, "component names mismatch");
else
Apply_Configuration_Specification
(Inst, Spec, Primary_Entity_Aspect);
@@ -1605,34 +1598,31 @@ package body Sem_Specs is
if Are_Nodes_Compatible (Comp_El, Ent_El) = Not_Compatible then
if not Error then
Error_Msg_Sem
- ("for default port binding of " & Disp_Node (Parent)
- & ":", Parent);
+ (+Parent, "for default port binding of %n:",
+ (1 => +Parent), Cont => True);
end if;
Error_Msg_Sem
- ("type of " & Disp_Node (Comp_El)
- & " declarared at " & Disp_Location (Comp_El), Parent);
+ (+Parent, "type of %n declarared at %l",
+ (+Comp_El, +Comp_El), Cont => True);
Error_Msg_Sem
- ("not compatible with type of " & Disp_Node (Ent_El)
- & " declarared at " & Disp_Location (Ent_El), Parent);
+ (+Parent, "not compatible with type of %n declarared at %l",
+ (+Ent_El, +Ent_El));
Error := True;
elsif Kind = Map_Port
and then not Check_Port_Association_Restriction
(Ent_El, Comp_El, Null_Iir)
then
if not Error then
- Error_Msg_Sem
- ("for default port binding of " & Disp_Node (Parent)
- & ":", Parent);
+ Error_Msg_Sem (+Parent, "for default port binding of %n",
+ (1 => +Parent), Cont => True);
end if;
- Error_Msg_Sem
- ("cannot associate "
- & Get_Mode_Name (Get_Mode (Ent_El))
- & " " & Disp_Node (Ent_El)
- & " declarared at " & Disp_Location (Ent_El), Parent);
- Error_Msg_Sem
- ("with actual port of mode "
- & Get_Mode_Name (Get_Mode (Comp_El))
- & " declared at " & Disp_Location (Comp_El), Parent);
+ Error_Msg_Sem (+Parent, "cannot associate "
+ & Get_Mode_Name (Get_Mode (Ent_El))
+ & " %n declarared at %l",
+ (+Ent_El, +Ent_El), Cont => True);
+ Error_Msg_Sem (+Parent, "with actual port of mode "
+ & Get_Mode_Name (Get_Mode (Comp_El))
+ & " declared at %l", +Comp_El);
Error := True;
end if;
Assoc := Create_Iir (Iir_Kind_Association_Element_By_Expression);
@@ -1661,8 +1651,8 @@ package body Sem_Specs is
while Comp_El /= Null_Iir loop
Ent_El := Find_Name_In_Chain (Ent_Chain, Get_Identifier (Comp_El));
if Ent_El = Null_Iir then
- Error_Msg_Sem (Disp_Node (Comp_El) & " has no association in "
- & Disp_Node (Entity), Parent);
+ Error_Msg_Sem (+Parent, "%n has no association in %n",
+ (+Comp_El, +Entity));
end if;
Comp_El := Get_Chain (Comp_El);
end loop;
diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb
index 3b2346cee..07d1e7f30 100644
--- a/src/vhdl/sem_stmts.adb
+++ b/src/vhdl/sem_stmts.adb
@@ -205,9 +205,10 @@ package body Sem_Stmts is
for J in 0 .. I - 1 loop
if not Is_Disjoint (Obj_Arr (I), Obj_Arr (J)) then
Error_Msg_Sem
- ("target is assigned more than once", Name_Arr (I));
+ (+Name_Arr (I), "target is assigned more than once",
+ Cont => True);
Error_Msg_Sem
- (" (previous assignment is here)", Name_Arr (J));
+ (+Name_Arr (J), " (previous assignment is here)");
return;
end if;
end loop;
@@ -253,14 +254,15 @@ package body Sem_Stmts is
-- It is an error if an element association in such an
-- aggregate contains an OTHERS choice or a choice that is
-- a discrete range.
- Error_Msg_Sem ("discrete range choice not allowed for target",
- Choice);
+ Error_Msg_Sem
+ (+Choice, "discrete range choice not allowed for target");
when Iir_Kind_Choice_By_Others =>
-- LRM93 8.4
-- It is an error if an element association in such an
-- aggregate contains an OTHERS choice or a choice that is
-- a discrete range.
- Error_Msg_Sem ("others choice not allowed for target", Choice);
+ Error_Msg_Sem
+ (+Choice, "others choice not allowed for target");
when Iir_Kind_Choice_By_Expression
| Iir_Kind_Choice_By_Name
| Iir_Kind_Choice_By_None =>
@@ -297,7 +299,7 @@ package body Sem_Stmts is
begin
Target_Object := Name_To_Object (Target);
if Target_Object = Null_Iir then
- Error_Msg_Sem ("target is not a signal name", Target);
+ Error_Msg_Sem (+Target, "target is not a signal name");
return;
end if;
@@ -307,22 +309,22 @@ package body Sem_Stmts is
when Iir_Kind_Interface_Signal_Declaration =>
if not Iir_Mode_Writable (Get_Mode (Target_Prefix)) then
Error_Msg_Sem
- (Disp_Node (Target_Prefix) & " can't be assigned", Target);
+ (+Target, "%n can't be assigned", +Target_Prefix);
else
Sem_Add_Driver (Target_Object, Stmt);
end if;
when Iir_Kind_Signal_Declaration =>
Sem_Add_Driver (Target_Object, Stmt);
when Iir_Kind_Guard_Signal_Declaration =>
- Error_Msg_Sem ("implicit GUARD signal cannot be assigned", Stmt);
+ Error_Msg_Sem (+Stmt, "implicit GUARD signal cannot be assigned");
return;
when others =>
- Error_Msg_Sem ("target (" & Disp_Node (Get_Base_Name (Target))
- & ") is not a signal", Stmt);
+ Error_Msg_Sem
+ (+Stmt, "target (%n) is not a signal", +Get_Base_Name (Target));
return;
end case;
if Get_Name_Staticness (Target_Object) < Staticness then
- Error_Msg_Sem ("signal name must be static", Stmt);
+ Error_Msg_Sem (+Stmt, "signal name must be static");
end if;
-- LRM93 2.1.1.2
@@ -356,7 +358,7 @@ package body Sem_Stmts is
-- It is an error if the target of a concurrent signal
-- assignment is neither a guarded target nor an
-- unguarded target.
- Error_Msg_Sem ("guarded and unguarded target", Target);
+ Error_Msg_Sem (+Target, "guarded and unguarded target");
end if;
end case;
end Check_Simple_Signal_Target;
@@ -369,15 +371,15 @@ package body Sem_Stmts is
begin
Target_Object := Name_To_Object (Target);
if Target_Object = Null_Iir then
- Error_Msg_Sem ("target is not a variable name", Stmt);
+ Error_Msg_Sem (+Stmt, "target is not a variable name");
return;
end if;
Target_Prefix := Get_Object_Prefix (Target_Object);
case Get_Kind (Target_Prefix) is
when Iir_Kind_Interface_Variable_Declaration =>
if not Iir_Mode_Writable (Get_Mode (Target_Prefix)) then
- Error_Msg_Sem (Disp_Node (Target_Prefix)
- & " cannot be written (bad mode)", Target);
+ Error_Msg_Sem (+Target, "%n cannot be written (bad mode)",
+ +Target_Prefix);
return;
end if;
when Iir_Kind_Variable_Declaration =>
@@ -389,13 +391,13 @@ package body Sem_Stmts is
-- class variable.
null;
when others =>
- Error_Msg_Sem (Disp_Node (Target_Prefix)
- & " is not a variable to be assigned", Stmt);
+ Error_Msg_Sem (+Stmt, "%n is not a variable to be assigned",
+ +Target_Prefix);
return;
end case;
if Get_Name_Staticness (Target_Object) < Staticness then
Error_Msg_Sem
- ("element of aggregate of variables must be a static name", Target);
+ (+Target, "element of a target aggregate must be a static name");
end if;
end Check_Simple_Variable_Target;
@@ -525,11 +527,11 @@ package body Sem_Stmts is
end if;
if Time < 0 then
Error_Msg_Sem
- ("waveform time expression must be >= 0", Expr);
+ (+Expr, "waveform time expression must be >= 0");
elsif Time <= Last_Time then
Error_Msg_Sem
- ("time must be greather than previous transaction",
- Expr);
+ (+Expr,
+ "time must be greather than previous transaction");
else
Last_Time := Time;
end if;
@@ -539,7 +541,7 @@ package body Sem_Stmts is
else
if We /= Waveform_Chain then
-- Time expression must be in ascending order.
- Error_Msg_Sem ("time expression required here", We);
+ Error_Msg_Sem (+We, "time expression required here");
end if;
-- LRM93 12.6.4
@@ -599,13 +601,13 @@ package body Sem_Stmts is
-- aggregate of guarded signals.
if Get_Guarded_Target_State (Assign_Stmt) = False then
Error_Msg_Sem
- ("null transactions can be assigned only to guarded signals",
- Assign_Stmt);
+ (+Assign_Stmt,
+ "null transactions can be assigned only to guarded signals");
end if;
else
if not Check_Implicit_Conversion (Targ_Type, Expr) then
Error_Msg_Sem
- ("length of value does not match length of target", We);
+ (+We, "length of value does not match length of target");
end if;
end if;
We := Get_Chain (We);
@@ -627,7 +629,7 @@ package body Sem_Stmts is
-- is a guarded target.
if Get_Guarded_Target_State (Stmt) = True then
Error_Msg_Sem
- ("not a guarded assignment for a guarded target", Stmt);
+ (+Stmt, "not a guarded assignment for a guarded target");
end if;
return;
end if;
@@ -637,7 +639,7 @@ package body Sem_Stmts is
end if;
Guard_Interpretation := Get_Interpretation (Std_Names.Name_Guard);
if not Valid_Interpretation (Guard_Interpretation) then
- Error_Msg_Sem ("no guard signals for this guarded assignment", Stmt);
+ Error_Msg_Sem (+Stmt, "no guard signals for this guarded assignment");
return;
end if;
@@ -653,13 +655,14 @@ package body Sem_Stmts is
| Iir_Kind_Guard_Signal_Declaration =>
null;
when others =>
- Error_Msg_Sem ("visible GUARD object is not a signal", Stmt);
- Error_Msg_Sem ("GUARD object is " & Disp_Node (Guard), Stmt);
+ Error_Msg_Sem (+Stmt, "visible GUARD object is not a signal",
+ Cont => True);
+ Error_Msg_Sem (+Stmt, "GUARD object is %n", +Guard);
return;
end case;
if Get_Type (Guard) /= Boolean_Type_Definition then
- Error_Msg_Sem ("GUARD is not of boolean type", Guard);
+ Error_Msg_Sem (+Guard, "GUARD is not of boolean type");
end if;
Set_Guard (Stmt, Guard);
end Sem_Guard;
@@ -733,7 +736,7 @@ package body Sem_Stmts is
exit when Done;
if not Is_Defined_Type (Target_Type) then
- Error_Msg_Sem ("cannot resolve type of waveform", Stmt);
+ Error_Msg_Sem (+Stmt, "cannot resolve type of waveform");
exit;
end if;
end loop;
@@ -846,10 +849,10 @@ package body Sem_Stmts is
exit when Done;
if not Is_Defined_Type (Stmt_Type) then
- Error_Msg_Sem ("cannot resolve type", Stmt);
+ Error_Msg_Sem (+Stmt, "cannot resolve type");
if Get_Kind (Target) = Iir_Kind_Aggregate then
-- Try to give an advice.
- Error_Msg_Sem ("use a qualified expression for the RHS", Stmt);
+ Error_Msg_Sem (+Stmt, "use a qualified expression for the RHS");
end if;
exit;
end if;
@@ -860,7 +863,7 @@ package body Sem_Stmts is
Expr: Iir;
begin
if Current_Subprogram = Null_Iir then
- Error_Msg_Sem ("return statement not in a subprogram body", Stmt);
+ Error_Msg_Sem (+Stmt, "return statement not in a subprogram body");
return;
end if;
Expr := Get_Expression (Stmt);
@@ -868,17 +871,17 @@ package body Sem_Stmts is
when Iir_Kind_Procedure_Declaration =>
if Expr /= Null_Iir then
Error_Msg_Sem
- ("return in a procedure can't have an expression", Stmt);
+ (+Stmt, "return in a procedure can't have an expression");
end if;
return;
when Iir_Kind_Function_Declaration =>
if Expr = Null_Iir then
Error_Msg_Sem
- ("return in a function must have an expression", Stmt);
+ (+Stmt, "return in a function must have an expression");
return;
end if;
when Iir_Kinds_Process_Statement =>
- Error_Msg_Sem ("return statement not allowed in a process", Stmt);
+ Error_Msg_Sem (+Stmt, "return statement not allowed in a process");
return;
when others =>
Error_Kind ("sem_return_statement", Stmt);
@@ -944,8 +947,8 @@ package body Sem_Stmts is
-- FIXME: complete the list.
-- * the name of an object whose subtype is locally static.
if Get_Type_Staticness (Expr_Type) /= Locally then
- Error_Msg_Sem ("object subtype is not locally static",
- Choice);
+ Error_Msg_Sem
+ (+Choice, "object subtype is not locally static");
return False;
end if;
when Iir_Kind_Indexed_Name =>
@@ -954,8 +957,8 @@ package body Sem_Stmts is
-- this list and whose indexing expressions are locally
-- static expression.
if Flags.Vhdl_Std = Vhdl_87 then
- Error_Msg_Sem ("indexed name not allowed here in vhdl87",
- Expr);
+ Error_Msg_Sem
+ (+Expr, "indexed name not allowed here in vhdl87");
return False;
end if;
if not Check_Odcat_Expression (Get_Prefix (Expr)) then
@@ -968,8 +971,8 @@ package body Sem_Stmts is
Get_Expr_Staticness (Get_First_Element
(Get_Index_List (Expr))) /= Locally
then
- Error_Msg_Sem ("indexing expression must be locally static",
- Expr);
+ Error_Msg_Sem
+ (+Expr, "indexing expression must be locally static");
return False;
end if;
when Iir_Kind_Slice_Name =>
@@ -983,15 +986,15 @@ package body Sem_Stmts is
-- discrete range is locally static, or ..
if False and Flags.Vhdl_Std = Vhdl_87 then
Error_Msg_Sem
- ("slice not allowed as case expression in vhdl87", Expr);
+ (+Expr, "slice not allowed as case expression in vhdl87");
return False;
end if;
if not Check_Odcat_Expression (Get_Prefix (Expr)) then
return False;
end if;
if Get_Type_Staticness (Expr_Type) /= Locally then
- Error_Msg_Sem ("slice discrete range must be locally static",
- Expr);
+ Error_Msg_Sem
+ (+Expr, "slice discrete range must be locally static");
return False;
end if;
when Iir_Kind_Function_Call =>
@@ -999,29 +1002,29 @@ package body Sem_Stmts is
-- * a function call whose return type mark denotes a
-- locally static subtype.
if Flags.Vhdl_Std = Vhdl_87 then
- Error_Msg_Sem ("function call not allowed here in vhdl87",
- Expr);
+ Error_Msg_Sem
+ (+Expr, "function call not allowed here in vhdl87");
return False;
end if;
if Get_Type_Staticness (Expr_Type) /= Locally then
- Error_Msg_Sem ("function call type is not locally static",
- Expr);
+ Error_Msg_Sem
+ (+Expr, "function call type is not locally static");
end if;
when Iir_Kind_Qualified_Expression
| Iir_Kind_Type_Conversion =>
-- * a qualified expression or type conversion whose type mark
-- denotes a locally static subtype.
if Get_Type_Staticness (Expr_Type) /= Locally then
- Error_Msg_Sem ("type mark is not a locally static subtype",
- Expr);
+ Error_Msg_Sem
+ (+Expr, "type mark is not a locally static subtype");
return False;
end if;
when Iir_Kind_Simple_Name
| Iir_Kind_Selected_Name =>
return Check_Odcat_Expression (Get_Named_Entity (Expr));
when others =>
- Error_Msg_Sem ("bad form of case expression (refer to LRM 8.8)",
- Choice);
+ Error_Msg_Sem
+ (+Choice, "bad form of case expression (refer to LRM 8.8)");
return False;
end case;
return True;
@@ -1043,16 +1046,16 @@ package body Sem_Stmts is
| Iir_Kind_Array_Type_Definition =>
if not Is_One_Dimensional_Array_Type (Choice_Type) then
Error_Msg_Sem
- ("expression must be of a one-dimensional array type",
- Choice);
+ (+Choice,
+ "expression must be of a one-dimensional array type");
return;
end if;
El_Type := Get_Base_Type (Get_Element_Subtype (Choice_Type));
if Get_Kind (El_Type) /= Iir_Kind_Enumeration_Type_Definition then
-- FIXME: check character.
Error_Msg_Sem
- ("element type of the expression must be a character type",
- Choice);
+ (+Choice,
+ "element type of the expression must be a character type");
return;
end if;
if not Check_Odcat_Expression (Choice) then
@@ -1060,7 +1063,7 @@ package body Sem_Stmts is
end if;
Sem_String_Choices_Range (Chain, Choice);
when others =>
- Error_Msg_Sem ("type of expression must be discrete", Choice);
+ Error_Msg_Sem (+Choice, "type of expression must be discrete");
end case;
end Sem_Case_Choices;
@@ -1111,7 +1114,7 @@ package body Sem_Stmts is
if Res = Error_Mark then
null;
elsif Is_Overload_List (Res) or else not Is_Object_Name (Res) then
- Error_Msg_Sem ("a sensitivity element must be a signal name", El);
+ Error_Msg_Sem (+El, "a sensitivity element must be a signal name");
else
Res := Finish_Sem_Name (El);
Prefix := Get_Object_Prefix (Res);
@@ -1123,12 +1126,12 @@ package body Sem_Stmts is
when Iir_Kind_Interface_Signal_Declaration =>
if not Iir_Mode_Readable (Get_Mode (Prefix)) then
Error_Msg_Sem
- (Disp_Node (Res) & " of mode out"
- & " can't be in a sensivity list", El);
+ (+El,
+ "%n of mode out can't be in a sensivity list", +Res);
end if;
when others =>
- Error_Msg_Sem (Disp_Node (Res)
- & " is neither a signal nor a port", El);
+ Error_Msg_Sem (+El,
+ "%n is neither a signal nor a port", +Res);
end case;
-- LRM 9.2
-- Only static signal names (see section 6.1) for which reading
@@ -1140,8 +1143,8 @@ package body Sem_Stmts is
-- signal name, and each name must denote a signal for which
-- reading is permitted.
if Get_Name_Staticness (Res) < Globally then
- Error_Msg_Sem ("sensitivity element " & Disp_Node (Res)
- & " must be a static name", El);
+ Error_Msg_Sem
+ (+El, "sensitivity element %n must be a static name", +Res);
end if;
Replace_Nth_Element (List, I, Res);
@@ -1190,7 +1193,7 @@ package body Sem_Stmts is
-- It is an error if a wait statement appears in a function
-- subprogram [...]
Error_Msg_Sem
- ("wait statement not allowed in a function subprogram", Stmt);
+ (+Stmt, "wait statement not allowed in a function subprogram");
return;
when Iir_Kind_Procedure_Declaration =>
-- LRM93 8.2
@@ -1208,7 +1211,7 @@ package body Sem_Stmts is
-- explicit process statement that includes a sensitivity list,
-- [...]
Error_Msg_Sem
- ("wait statement not allowed in a sensitized process", Stmt);
+ (+Stmt, "wait statement not allowed in a sensitized process");
return;
when others =>
raise Internal_Error;
@@ -1235,7 +1238,7 @@ package body Sem_Stmts is
if Get_Expr_Staticness (Expr) = Locally
and then Get_Value (Expr) < 0
then
- Error_Msg_Sem ("timeout value must be positive", Stmt);
+ Error_Msg_Sem (+Stmt, "timeout value must be positive");
end if;
end if;
end if;
@@ -1289,7 +1292,7 @@ package body Sem_Stmts is
null;
when others =>
-- FIXME: should emit a message for label mismatch.
- Error_Msg_Sem ("exit/next must be inside a loop", Stmt);
+ Error_Msg_Sem (+Stmt, "exit/next must be inside a loop");
exit;
end case;
end loop;
@@ -1362,7 +1365,7 @@ package body Sem_Stmts is
and then Get_Passive_Flag (Current_Concurrent_Statement)
then
Error_Msg_Sem
- ("signal statement forbidden in passive process", Stmt);
+ (+Stmt, "signal statement forbidden in passive process");
end if;
when Iir_Kind_Variable_Assignment_Statement
| Iir_Kind_Conditional_Variable_Assignment_Statement =>
@@ -1471,14 +1474,14 @@ package body Sem_Stmts is
begin
-- FIXME: move this check in parse ?
if Is_Passive then
- Error_Msg_Sem ("component instantiation forbidden in entity", Stmt);
+ Error_Msg_Sem (+Stmt, "component instantiation forbidden in entity");
end if;
-- Check for label.
-- This cannot be moved in parse since a procedure_call may be revert
-- into a component instantiation.
if Get_Label (Stmt) = Null_Identifier then
- Error_Msg_Sem ("component instantiation requires a label", Stmt);
+ Error_Msg_Sem (+Stmt, "component instantiation requires a label");
end if;
-- Look for the component.
@@ -1572,7 +1575,7 @@ package body Sem_Stmts is
Decl := Get_Interface_Declaration_Chain (Imp);
while Decl /= Null_Iir loop
if Get_Mode (Decl) in Iir_Out_Modes then
- Error_Msg_Sem (Disp_Node (Imp) & " is not passive", Stmt);
+ Error_Msg_Sem (+Stmt, "%n is not passive", +Imp);
exit;
end if;
Decl := Get_Chain (Decl);
@@ -1687,7 +1690,7 @@ package body Sem_Stmts is
if Get_Type (Param) /= Null_Iir
and then Get_Type_Staticness (Get_Type (Param)) < Globally
then
- Error_Msg_Sem ("range must be a static discrete range", Stmt);
+ Error_Msg_Sem (+Stmt, "range must be a static discrete range");
end if;
-- In the same declarative region.
@@ -1740,7 +1743,7 @@ package body Sem_Stmts is
and then Get_Expr_Staticness (Condition) < Globally
then
Error_Msg_Sem
- ("condition must be a static expression", Condition);
+ (+Condition, "condition must be a static expression");
else
Set_Condition (Clause, Condition);
end if;
@@ -1781,7 +1784,7 @@ package body Sem_Stmts is
if Get_Expr_Staticness (Expr) < Globally then
Error_Msg_Sem
- ("case expression must be a static expression", Expr);
+ (+Expr, "case expression must be a static expression");
end if;
Sem_Case_Choices (Expr, Chain, Get_Location (Stmt));
@@ -1880,8 +1883,8 @@ package body Sem_Stmts is
Res_Type := Search_Compatible_Type (Get_Type (Left), Get_Type (Right));
if Res_Type = Null_Iir then
- Error_Msg_Sem ("types of left and right expressions are incompatible",
- Stmt);
+ Error_Msg_Sem
+ (+Stmt, "types of left and right expressions are incompatible");
return;
end if;
@@ -1899,7 +1902,7 @@ package body Sem_Stmts is
procedure No_Generate_Statement is
begin
if Is_Passive then
- Error_Msg_Sem ("generate statement forbidden in entity", El);
+ Error_Msg_Sem (+El, "generate statement forbidden in entity");
end if;
end No_Generate_Statement;
@@ -1921,12 +1924,12 @@ package body Sem_Stmts is
when Iir_Kind_Concurrent_Simple_Signal_Assignment
| Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
if Is_Passive then
- Error_Msg_Sem ("signal assignment forbidden in entity", El);
+ Error_Msg_Sem (+El, "signal assignment forbidden in entity");
end if;
Sem_Signal_Assignment (El);
when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
if Is_Passive then
- Error_Msg_Sem ("signal assignment forbidden in entity", El);
+ Error_Msg_Sem (+El, "signal assignment forbidden in entity");
end if;
Sem_Concurrent_Selected_Signal_Assignment (El);
when Iir_Kind_Sensitized_Process_Statement =>
@@ -1943,7 +1946,7 @@ package body Sem_Stmts is
Sem_Assertion_Statement (El);
when Iir_Kind_Block_Statement =>
if Is_Passive then
- Error_Msg_Sem ("block forbidden in entity", El);
+ Error_Msg_Sem (+El, "block forbidden in entity");
end if;
Sem_Block_Statement (El);
when Iir_Kind_If_Generate_Statement =>
@@ -2093,10 +2096,8 @@ package body Sem_Stmts is
if Get_Signal_Driver (Sig_Object) /= Null_Iir and then
Get_Signal_Driver (Sig_Object) /= Current_Concurrent_Statement
then
- Error_Msg_Sem ("unresolved " & Disp_Node (Sig_Object)
- & " has already a driver at "
- & Disp_Location (Get_Signal_Driver (Sig_Object)),
- Stmt);
+ Error_Msg_Sem (+Stmt, "unresolved %n has already a driver at %l",
+ (+Sig_Object, +Get_Signal_Driver (Sig_Object)));
else
Set_Signal_Driver (Sig_Object, Current_Concurrent_Statement);
end if;
@@ -2130,8 +2131,7 @@ package body Sem_Stmts is
or else (Get_Kind (Get_Parent (Sig_Object))
/= Iir_Kind_Procedure_Declaration)
then
- Error_Msg_Sem
- (Disp_Node (Sig_Object) & " is not a formal parameter", Stmt);
+ Error_Msg_Sem (+Stmt, "%n is not a formal parameter", +Sig_Object);
end if;
end if;
end Sem_Add_Driver;
diff --git a/src/vhdl/sem_types.adb b/src/vhdl/sem_types.adb
index 4b033ddfb..9fca01ef1 100644
--- a/src/vhdl/sem_types.adb
+++ b/src/vhdl/sem_types.adb
@@ -136,12 +136,12 @@ package body Sem_Types is
-- Emit error message for overflow and replace with a value to avoid
-- error storm.
if Get_Kind (Left) = Iir_Kind_Overflow_Literal then
- Error_Msg_Sem ("overflow in left bound", Left);
+ Error_Msg_Sem (+Left, "overflow in left bound");
Left := Build_Extreme_Value
(Get_Direction (Expr) = Iir_Downto, Left);
end if;
if Get_Kind (Right) = Iir_Kind_Overflow_Literal then
- Error_Msg_Sem ("overflow in right bound", Right);
+ Error_Msg_Sem (+Right, "overflow in right bound");
Right := Build_Extreme_Value
(Get_Direction (Expr) = Iir_To, Right);
end if;
@@ -158,25 +158,26 @@ package body Sem_Types is
if Bt_L_Kind /= Iir_Kind_Integer_Type_Definition
and then Bt_R_Kind = Iir_Kind_Integer_Type_Definition
then
- Error_Msg_Sem ("left bound must be an integer expression", Left);
+ Error_Msg_Sem (+Left, "left bound must be an integer expression");
return Null_Iir;
end if;
if Bt_R_Kind /= Iir_Kind_Integer_Type_Definition
and then Bt_L_Kind = Iir_Kind_Integer_Type_Definition
then
- Error_Msg_Sem ("right bound must be an integer expression", Left);
+ Error_Msg_Sem
+ (+Right, "right bound must be an integer expression");
return Null_Iir;
end if;
if Bt_R_Kind /= Iir_Kind_Integer_Type_Definition
and then Bt_L_Kind /= Iir_Kind_Integer_Type_Definition
then
- Error_Msg_Sem ("each bound must be an integer expression", Expr);
+ Error_Msg_Sem (+Expr, "each bound must be an integer expression");
return Null_Iir;
end if;
else
if Bt_L_Kind /= Bt_R_Kind then
Error_Msg_Sem
- ("left and right bounds must be of the same type class", Expr);
+ (+Expr, "left and right bounds must be of the same type class");
return Null_Iir;
end if;
case Bt_L_Kind is
@@ -186,7 +187,7 @@ package body Sem_Types is
when others =>
-- Enumeration range are not allowed to define a new type.
Error_Msg_Sem
- ("bad range type, only integer or float is allowed", Expr);
+ (+Expr, "bad range type, only integer or float is allowed");
return Null_Iir;
end case;
end if;
@@ -215,8 +216,8 @@ package body Sem_Types is
Set_Resolved_Flag (Ntype, False);
Set_Signal_Type_Flag (Ntype, True);
if Get_Type_Staticness (Ntype) /= Locally then
- Error_Msg_Sem ("range constraint of type must be locally static",
- Decl);
+ Error_Msg_Sem
+ (+Decl, "range constraint of type must be locally static");
end if;
return Ntype;
end Create_Integer_Type;
@@ -346,8 +347,8 @@ package body Sem_Types is
Get_Range_Constraint (Universal_Integer_Subtype_Definition);
end if;
if Get_Expr_Staticness (Range_Expr1) /= Locally then
- Error_Msg_Sem ("range constraint for a physical type must be static",
- Range_Expr1);
+ Error_Msg_Sem (+Range_Expr1,
+ "range constraint for a physical type must be static");
Range_Expr1 :=
Get_Range_Constraint (Universal_Integer_Subtype_Definition);
else
@@ -435,7 +436,7 @@ package body Sem_Types is
then
if not Eval_Int_In_Range (Get_Value (Unit), Range_Expr1) then
Error_Msg_Sem
- ("physical literal does not lie within the range", Unit);
+ (+Unit, "physical literal does not lie within the range");
end if;
end if;
else
@@ -484,10 +485,10 @@ package body Sem_Types is
case Get_Kind (El_Type) is
when Iir_Kind_File_Type_Definition =>
Error_Msg_Sem
- ("file type element not allowed in a composite type", Loc);
+ (+Loc, "file type element not allowed in a composite type");
when Iir_Kind_Protected_Type_Declaration =>
Error_Msg_Sem
- ("protected type element not allowed in a composite type", Loc);
+ (+Loc, "protected type element not allowed in a composite type");
when others =>
null;
end case;
@@ -521,8 +522,9 @@ package body Sem_Types is
if Vhdl_Std < Vhdl_08
and then not Is_Fully_Constrained_Type (El_Type)
then
- Error_Msg_Sem ("array element of unconstrained "
- & Disp_Node (El_Type) & " is not allowed", Def);
+ Error_Msg_Sem
+ (+Def, "array element of unconstrained %n is not allowed",
+ +El_Type);
end if;
Set_Resolved_Flag (Def, Get_Resolved_Flag (El_Type));
end Sem_Array_Element;
@@ -572,8 +574,8 @@ package body Sem_Types is
/= Iir_Kind_Protected_Type_Declaration
then
Error_Msg_Sem
- ("formal parameter method must not be "
- & "access or file type", Inter);
+ (+Inter, "formal parameter method must not be "
+ & "access or file type");
end if;
Inter := Get_Chain (Inter);
end loop;
@@ -583,15 +585,15 @@ package body Sem_Types is
and then Get_Signal_Type_Flag (Inter_Type) = False
then
Error_Msg_Sem
- ("method return type must not be access of file",
- El);
+ (+El,
+ "method return type must not be access of file");
end if;
end if;
end;
when others =>
Error_Msg_Sem
- (Disp_Node (El)
- & " are not allowed in protected type declaration", El);
+ (+El, "%n are not allowed in protected type declaration",
+ +El);
end case;
El := Get_Chain (El);
end loop;
@@ -636,27 +638,27 @@ package body Sem_Types is
Set_Protected_Type_Declaration (Bod, Decl);
if Get_Protected_Type_Body (Decl) /= Null_Iir then
Error_Msg_Sem
- ("protected type body already declared for "
- & Disp_Node (Decl), Bod);
+ (+Bod, "protected type body already declared for %n",
+ (1 => +Decl), Cont => True);
Error_Msg_Sem
- ("(previous body)", Get_Protected_Type_Body (Decl));
+ (+Get_Protected_Type_Body (Decl), "(previous body)");
Decl := Null_Iir;
elsif not Get_Visible_Flag (Type_Decl) then
-- Can this happen ?
Error_Msg_Sem
- ("protected type declaration not yet visible", Bod);
+ (+Bod, "protected type declaration not yet visible",
+ Cont => True);
Error_Msg_Sem
- ("(location of protected type declaration)", Decl);
+ (+Decl, "(location of protected type declaration)");
Decl := Null_Iir;
else
Set_Protected_Type_Body (Decl, Bod);
end if;
else
Error_Msg_Sem
- ("no protected type declaration for this body", Bod);
+ (+Bod, "no protected type declaration for this body");
if Decl /= Null_Iir then
- Error_Msg_Sem
- ("(found " & Disp_Node (Decl) & " declared here)", Decl);
+ Error_Msg_Sem (+Decl, "(found %n declared here)", +Decl);
Decl := Null_Iir;
end if;
end if;
@@ -701,8 +703,7 @@ package body Sem_Types is
null;
when others =>
Error_Msg_Sem
- (Disp_Node (El) & " not allowed in a protected type body",
- El);
+ (+El, "%n not allowed in a protected type body", +El);
end case;
El := Get_Chain (El);
end loop;
@@ -873,8 +874,9 @@ package body Sem_Types is
and then not Is_Fully_Constrained_Type (El_Type)
then
Error_Msg_Sem
- ("element declaration of unconstrained "
- & Disp_Node (El_Type) & " is not allowed", El);
+ (+El,
+ "element declaration of unconstrained %n is not allowed",
+ +El_Type);
end if;
Resolved_Flag :=
Resolved_Flag and Get_Resolved_Flag (El_Type);
@@ -915,8 +917,9 @@ package body Sem_Types is
Index_Type := Get_Type (Index_Type);
if Get_Kind (Index_Type) not in Iir_Kinds_Discrete_Type_Definition
then
- Error_Msg_Sem ("an index type of an array must be a discrete type",
- Index_Type);
+ Error_Msg_Sem
+ (+Index_Type,
+ "an index type of an array must be a discrete type");
-- FIXME: disp type Index_Type ?
end if;
end loop;
@@ -1080,12 +1083,12 @@ package body Sem_Types is
when Iir_Kind_File_Type_Definition =>
-- LRM 3.3
-- The designated type must not be a file type.
- Error_Msg_Sem ("designated type must not be a file type", Def);
+ Error_Msg_Sem (+Def, "designated type must not be a file type");
when Iir_Kind_Protected_Type_Declaration =>
-- LRM02 3.3
-- [..] or a protected type.
Error_Msg_Sem
- ("designated type must not be a protected type", Def);
+ (+Def, "designated type must not be a protected type");
when others =>
null;
end case;
@@ -1115,16 +1118,14 @@ package body Sem_Types is
-- or an access type.
-- If the base type is a composite type, it must not
-- contain a subelement of an access type.
- Error_Msg_Sem
- (Disp_Node (Type_Mark) & " cannot be a file type", Def);
+ Error_Msg_Sem (+Def, "%n cannot be a file type", +Type_Mark);
elsif Get_Kind (Type_Mark) in Iir_Kinds_Array_Type_Definition then
-- LRM 3.4
-- If the base type is an array type, it must be a one
-- dimensional array type.
if not Is_One_Dimensional_Array_Type (Type_Mark) then
Error_Msg_Sem
- ("multi-dimensional " & Disp_Node (Type_Mark)
- & " cannot be a file type", Def);
+ (+Def, "multi-dimensional %n cannot be a file type", +Type_Mark);
end if;
end if;
@@ -1285,8 +1286,7 @@ package body Sem_Types is
-- A resolution function must be a [pure] function;
if Flags.Vhdl_Std >= Vhdl_93 and then Get_Pure_Flag (Func) = False then
if Atype /= Null_Iir then
- Error_Msg_Sem
- ("resolution " & Disp_Node (Func) & " must be pure", Atype);
+ Error_Msg_Sem (+Atype, "resolution %n must be pure", +Func);
end if;
return False;
end if;
@@ -1323,12 +1323,13 @@ package body Sem_Types is
if not Has_Error then
Has_Error := True;
Error_Msg_Sem
- ("can't resolve overload for resolution function",
- Atype);
- Error_Msg_Sem ("candidate functions are:", Atype);
- Error_Msg_Sem (" " & Disp_Subprg (Func), Func);
+ (+Atype,
+ "can't resolve overload for resolution function",
+ Cont => True);
+ Error_Msg_Sem (+Atype, "candidate functions are:");
+ Error_Msg_Sem (+Func, " " & Disp_Subprg (Func));
end if;
- Error_Msg_Sem (" " & Disp_Subprg (El), El);
+ Error_Msg_Sem (+El, " " & Disp_Subprg (El));
else
Res := El;
end if;
@@ -1346,8 +1347,8 @@ package body Sem_Types is
end if;
if Res = Null_Iir then
- Error_Msg_Sem ("no matching resolution function for "
- & Disp_Node (Name), Atype);
+ Error_Msg_Sem
+ (+Atype, "no matching resolution function for %n", +Name);
else
Name1 := Finish_Sem_Name (Name);
Mark_Subprogram_Used (Res);
@@ -1390,8 +1391,8 @@ package body Sem_Types is
Resolv_El := Get_Resolution_Indication (Resolution);
when Iir_Kind_Record_Resolution =>
Error_Msg_Sem
- ("record resolution not allowed for array subtype",
- Resolution);
+ (+Resolution,
+ "record resolution not allowed for array subtype");
when others =>
Error_Kind ("sem_array_constraint(resolution)", Resolution);
end case;
@@ -1408,7 +1409,7 @@ package body Sem_Types is
-- def must be a constrained array.
if Get_Range_Constraint (Def) /= Null_Iir then
Error_Msg_Sem
- ("cannot use a range constraint for array types", Def);
+ (+Def, "cannot use a range constraint for array types");
return Copy_Subtype_Indication (Type_Mark);
end if;
@@ -1453,8 +1454,8 @@ package body Sem_Types is
if Get_Kind (Type_Mark) = Iir_Kind_Array_Subtype_Definition
and then Get_Index_Constraint_Flag (Type_Mark)
then
- Error_Msg_Sem ("constrained array cannot be re-constrained",
- Def);
+ Error_Msg_Sem
+ (+Def, "constrained array cannot be re-constrained");
end if;
if Subtype_Index_List = Null_Iir_List then
-- Array is not constrained.
@@ -1469,10 +1470,9 @@ package body Sem_Types is
if Type_Index = Null_Iir then
Error_Msg_Sem
- ("subtype has more indexes than "
- & Disp_Node (Type_Mark)
- & " defined at " & Disp_Location (Type_Mark),
- Subtype_Index);
+ (+Subtype_Index,
+ "subtype has more indexes than %n defined at %l",
+ (+Type_Mark, +Type_Mark));
-- Forget extra indexes.
Set_Nbr_Elements (Subtype_Index_List, I);
exit;
@@ -1480,10 +1480,9 @@ package body Sem_Types is
if Subtype_Index = Null_Iir then
if not Error_Seen then
Error_Msg_Sem
- ("subtype has less indexes than "
- & Disp_Node (Type_Mark)
- & " defined at "
- & Disp_Location (Type_Mark), Def);
+ (+Def,
+ "subtype has less indexes than %n defined at %l",
+ (+Type_Mark, +Type_Mark));
Error_Seen := True;
end if;
else
@@ -1528,11 +1527,11 @@ package body Sem_Types is
-- type, or an access type whose designated type is such
-- an array type.
Error_Msg_Sem
- ("only unconstrained array type may be contrained "
- &"by index", Def);
+ (+Def,
+ "only unconstrained array type may be contrained by index",
+ Cont => True);
Error_Msg_Sem
- (" (type mark is " & Disp_Node (Type_Mark) & ")",
- Type_Mark);
+ (+Type_Mark, " (type mark is %n)", +Type_Mark);
return Type_Mark;
end case;
end if;
@@ -1584,7 +1583,7 @@ package body Sem_Types is
El : Iir;
begin
if Get_Kind (Name) /= Iir_Kind_Parenthesis_Name then
- Error_Msg_Sem ("record element constraint expected", Name);
+ Error_Msg_Sem (+Name, "record element constraint expected");
return Null_Iir;
else
Prefix := Get_Prefix (Name);
@@ -1594,8 +1593,8 @@ package body Sem_Types is
Prefix := Get_Prefix (Prefix);
end loop;
if Get_Kind (Prefix) /= Iir_Kind_Simple_Name then
- Error_Msg_Sem ("record element name must be a simple name",
- Prefix);
+ Error_Msg_Sem
+ (+Prefix, "record element name must be a simple name");
return Null_Iir;
else
El := Create_Iir (Iir_Kind_Record_Element_Constraint);
@@ -1628,7 +1627,7 @@ package body Sem_Types is
if Get_Kind (Chain) /= Iir_Kind_Association_Element_By_Expression
or else Get_Formal (Chain) /= Null_Iir
then
- Error_Msg_Sem ("badly formed record constraint", Chain);
+ Error_Msg_Sem (+Chain, "badly formed record constraint");
else
El := Reparse_As_Record_Element_Constraint (Get_Actual (Chain));
if El /= Null_Iir then
@@ -1669,7 +1668,7 @@ package body Sem_Types is
Chain := Get_Association_Chain (Name);
if Get_Kind (Chain) = Iir_Kind_Association_Element_Open then
if Get_Chain (Chain) /= Null_Iir then
- Error_Msg_Sem ("'open' must be alone", Chain);
+ Error_Msg_Sem (+Chain, "'open' must be alone");
end if;
else
El_List := Create_Iir_List;
@@ -1678,7 +1677,7 @@ package body Sem_Types is
if Get_Kind (Chain) /= Iir_Kind_Association_Element_By_Expression
or else Get_Formal (Chain) /= Null_Iir
then
- Error_Msg_Sem ("bad form of array constraint", Chain);
+ Error_Msg_Sem (+Chain, "bad form of array constraint");
else
Append_Element (El_List, Get_Actual (Chain));
end if;
@@ -1764,8 +1763,8 @@ package body Sem_Types is
Res_List := Get_Elements_Declaration_List (Resolution);
when Iir_Kind_Array_Subtype_Definition =>
Error_Msg_Sem
- ("resolution indication must be an array element resolution",
- Resolution);
+ (+Resolution,
+ "resolution indication must be an array element resolution");
when others =>
Error_Kind ("sem_record_constraint(resolution)", Resolution);
end case;
@@ -1787,16 +1786,16 @@ package body Sem_Types is
exit when El = Null_Iir;
Tm_El := Find_Name_In_List (Tm_El_List, Get_Identifier (El));
if Tm_El = Null_Iir then
- Error_Msg_Sem (Disp_Node (Type_Mark)
- & "has no " & Disp_Node (El), El);
+ Error_Msg_Sem (+El, "%n has no %n", (+Type_Mark, +El));
else
Set_Element_Declaration (El, Tm_El);
Pos := Natural (Get_Element_Position (Tm_El));
if Els (Pos) /= Null_Iir then
Error_Msg_Sem
- (Disp_Node (El) & " was already constrained", El);
+ (+El, "%n was already constrained",
+ (1 => +El), Cont => True);
Error_Msg_Sem
- (" (location of previous constrained)", Els (Pos));
+ (+Els (Pos), " (location of previous constrained)");
else
Els (Pos) := El;
Set_Parent (El, Res);
@@ -1814,8 +1813,8 @@ package body Sem_Types is
(El_Type);
when others =>
Error_Msg_Sem
- ("only composite types may be constrained",
- El_Type);
+ (+El_Type,
+ "only composite types may be constrained");
end case;
end if;
Set_Type (El, El_Type);
@@ -1831,15 +1830,14 @@ package body Sem_Types is
exit when El = Null_Iir;
Tm_El := Find_Name_In_List (Tm_El_List, Get_Identifier (El));
if Tm_El = Null_Iir then
- Error_Msg_Sem (Disp_Node (Type_Mark)
- & "has no " & Disp_Node (El), El);
+ Error_Msg_Sem (+El, "%n has no %n", (+Type_Mark, +El));
else
Pos := Natural (Get_Element_Position (Tm_El));
if Res_Els (Pos) /= Null_Iir then
+ Error_Msg_Sem (+El, "%n was already resolved",
+ (1 => +El), Cont => True);
Error_Msg_Sem
- (Disp_Node (El) & " was already resolved", El);
- Error_Msg_Sem
- (" (location of previous constrained)", Els (Pos));
+ (+Els (Pos), " (location of previous constrained)");
else
Res_Els (Pos) := Get_Element_Declaration (El);
end if;
@@ -1910,9 +1908,11 @@ package body Sem_Types is
-- FIXME: find the correct sentence from LRM
-- GHDL: subtype_definition may also be used just to add
-- a resolution function.
- Error_Msg_Sem ("only scalar types may be constrained by range", Def);
- Error_Msg_Sem (" (type mark is " & Disp_Node (Type_Mark) & ")",
- Type_Mark);
+ Error_Msg_Sem
+ (+Def, "only scalar types may be constrained by range",
+ Cont => True);
+ Error_Msg_Sem
+ (+Type_Mark, " (type mark is %n)", +Type_Mark);
Res := Copy_Subtype_Indication (Type_Mark);
else
Tolerance := Get_Tolerance (Def);
@@ -1956,8 +1956,8 @@ package body Sem_Types is
--
-- FIXME: should be moved into sem_subtype_indication
if Get_Kind (Res) /= Iir_Kind_Floating_Subtype_Definition then
- Error_Msg_Sem ("tolerance allowed only for floating subtype",
- Tolerance);
+ Error_Msg_Sem
+ (+Tolerance, "tolerance allowed only for floating subtype");
else
-- LRM93 4.2 Subtype declarations
-- If the subtype indication includes a tolerance aspect, then
@@ -1966,8 +1966,8 @@ package body Sem_Types is
if Tolerance /= Null_Iir
and then Get_Expr_Staticness (Tolerance) /= Locally
then
- Error_Msg_Sem ("tolerance must be a static string",
- Tolerance);
+ Error_Msg_Sem
+ (+Tolerance, "tolerance must be a static string");
end if;
Set_Tolerance (Res, Tolerance);
end if;
@@ -1977,8 +1977,8 @@ package body Sem_Types is
if Resolution /= Null_Iir then
-- LRM08 6.3 Subtype declarations.
if Get_Kind (Resolution) not in Iir_Kinds_Denoting_Name then
- Error_Msg_Sem ("resolution indication must be a function name",
- Resolution);
+ Error_Msg_Sem
+ (+Resolution, "resolution indication must be a function name");
else
Sem_Resolution_Function (Resolution, Res);
end if;
@@ -2010,7 +2010,7 @@ package body Sem_Types is
-- may not contain a resolution function.
if Resolution /= Null_Iir then
Error_Msg_Sem
- ("resolution function not allowed for an access type", Def);
+ (+Def, "resolution function not allowed for an access type");
end if;
case Get_Kind (Def) is
@@ -2048,7 +2048,7 @@ package body Sem_Types is
if Get_Kind (Def) /= Iir_Kind_Subtype_Definition
or else Get_Range_Constraint (Def) /= Null_Iir
then
- Error_Msg_Sem ("file types can't be constrained", Def);
+ Error_Msg_Sem (+Def, "file types can't be constrained");
return Type_Mark;
end if;
@@ -2057,7 +2057,7 @@ package body Sem_Types is
-- may not contain a resolution function.
if Resolution /= Null_Iir then
Error_Msg_Sem
- ("resolution function not allowed for file types", Def);
+ (+Def, "resolution function not allowed for file types");
return Type_Mark;
end if;
Free_Name (Def);
@@ -2070,7 +2070,7 @@ package body Sem_Types is
if Get_Kind (Def) /= Iir_Kind_Subtype_Definition
or else Get_Range_Constraint (Def) /= Null_Iir
then
- Error_Msg_Sem ("protected types can't be constrained", Def);
+ Error_Msg_Sem (+Def, "protected types can't be constrained");
return Type_Mark;
end if;
@@ -2079,7 +2079,7 @@ package body Sem_Types is
-- not contain a resolution function.
if Resolution /= Null_Iir then
Error_Msg_Sem
- ("resolution function not allowed for file types", Def);
+ (+Def, "resolution function not allowed for file types");
return Type_Mark;
end if;
Free_Name (Def);
diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb
index 93d60d928..f205ea1e4 100644
--- a/src/vhdl/simulate/elaboration.adb
+++ b/src/vhdl/simulate/elaboration.adb
@@ -1463,7 +1463,7 @@ package body Elaboration is
-- the design entity implied by the entity aspect contains formal ports.
if Formal_Chain = Null_Iir then
if Local_Chain /= Null_Iir then
- Error_Msg_Sem ("cannot create default map aspect", Node);
+ Error_Msg_Sem (+Node, "cannot create default map aspect");
end if;
return Null_Iir;
end if;
@@ -1495,8 +1495,7 @@ package body Elaboration is
-- its mode and type are not appropriate for such an
-- association.
-- FIXME: mode/type check.
- Error_Msg_Sem
- ("cannot associate local " & Disp_Node (Local), Node);
+ Error_Msg_Sem (+Node, "cannot associate local %n", +Local);
exit;
end if;
if Assoc_List (Pos) /= Null_Iir then
@@ -2279,7 +2278,7 @@ package body Elaboration is
-- and must evaluate to a non-negative value.
if Time < 0 then
- Error_Msg_Sem ("time must be non-negative", Decl);
+ Error_Msg_Sem (+Decl, "time must be non-negative");
end if;
-- LRM93 �12.3.2.3
diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb
index 3bff1a42e..4c5083ef6 100644
--- a/src/vhdl/translate/trans-chap1.adb
+++ b/src/vhdl/translate/trans-chap1.adb
@@ -222,7 +222,7 @@ package body Trans.Chap1 is
Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack;
begin
if Get_Foreign_Flag (Arch) then
- Error_Msg_Sem ("FOREIGN architectures are not yet handled", Arch);
+ Error_Msg_Sem (+Arch, "FOREIGN architectures are not yet handled");
end if;
Info := Add_Info (Arch, Kind_Block);
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index e39d42ed6..f7a5da6a4 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -298,8 +298,7 @@ package body Trans.Chap3 is
else
if Translation.Flag_Only_32b then
Error_Msg_Sem
- ("range of " & Disp_Node (Get_Type_Declarator (St))
- & " is too large", St);
+ (+St, "range of %n is too large", +Get_Type_Declarator (St));
return Precision_32;
end if;
return Precision_64;
diff --git a/src/vhdl/translate/trans_be.adb b/src/vhdl/translate/trans_be.adb
index 8a8fa63ee..998271ef6 100644
--- a/src/vhdl/translate/trans_be.adb
+++ b/src/vhdl/translate/trans_be.adb
@@ -129,7 +129,7 @@ package body Trans_Be is
begin
case Get_Kind (Decl) is
when Iir_Kind_Architecture_Body =>
- Error_Msg_Sem ("FOREIGN architectures are not yet handled", Decl);
+ Error_Msg_Sem (+Decl, "FOREIGN architectures are not yet handled");
when Iir_Kind_Procedure_Declaration
| Iir_Kind_Function_Declaration =>
null;
diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb
index 79999f78a..27da99f97 100644
--- a/src/vhdl/translate/translation.adb
+++ b/src/vhdl/translate/translation.adb
@@ -107,7 +107,7 @@ package body Translation is
when others =>
if Get_Expr_Staticness (Expr) /= Locally then
Error_Msg_Sem
- ("value of FOREIGN attribute must be locally static", Expr);
+ (+Expr, "value of FOREIGN attribute must be locally static");
Nam_Length := 0;
else
raise Internal_Error;
@@ -135,7 +135,7 @@ package body Translation is
end loop;
if P > Nam_Length then
Error_Msg_Sem
- ("missing subprogram/library name after VHPIDIRECT", Spec);
+ (+Spec, "missing subprogram/library name after VHPIDIRECT");
end if;
-- Extract library.
Lf := P;
@@ -154,7 +154,7 @@ package body Translation is
end loop;
Sl := P;
if P < Nam_Length then
- Error_Msg_Sem ("garbage at end of VHPIDIRECT", Spec);
+ Error_Msg_Sem (+Spec, "garbage at end of VHPIDIRECT");
end if;
-- Accept empty library.
@@ -178,8 +178,8 @@ package body Translation is
return Foreign_Info_Type'(Kind => Foreign_Intrinsic);
else
Error_Msg_Sem
- ("value of 'FOREIGN attribute does not begin with VHPIDIRECT",
- Spec);
+ (+Spec,
+ "value of 'FOREIGN attribute does not begin with VHPIDIRECT");
return Foreign_Bad;
end if;
end Translate_Foreign_Id;
--
cgit v1.2.3