diff options
author | Tristan Gingold <tgingold@free.fr> | 2016-08-02 06:02:07 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2016-08-02 08:01:36 +0200 |
commit | ee0e651d9b3946910d513e6a670453e25e5f014d (patch) | |
tree | 6b8df5b5630fa7c7cd78583663eac88c1d88f387 | |
parent | cdb323b1dbfccbcff5c63804ff73e6e86e4d05e8 (diff) | |
download | ghdl-ee0e651d9b3946910d513e6a670453e25e5f014d.tar.gz ghdl-ee0e651d9b3946910d513e6a670453e25e5f014d.tar.bz2 ghdl-ee0e651d9b3946910d513e6a670453e25e5f014d.zip |
Rewrite error messages.
-rw-r--r-- | src/ghdldrv/ghdlrun.adb | 8 | ||||
-rw-r--r-- | src/libraries.adb | 42 | ||||
-rw-r--r-- | src/vhdl/errorout.adb | 65 | ||||
-rw-r--r-- | src/vhdl/errorout.ads | 17 | ||||
-rw-r--r-- | src/vhdl/evaluation.adb | 8 | ||||
-rw-r--r-- | src/vhdl/ieee-std_logic_1164.adb | 2 | ||||
-rw-r--r-- | src/vhdl/ieee-vital_timing.adb | 130 | ||||
-rw-r--r-- | src/vhdl/parse.adb | 7 | ||||
-rw-r--r-- | src/vhdl/psl-errors.ads | 2 | ||||
-rw-r--r-- | src/vhdl/sem.adb | 184 | ||||
-rw-r--r-- | src/vhdl/sem_assocs.adb | 157 | ||||
-rw-r--r-- | src/vhdl/sem_decls.adb | 189 | ||||
-rw-r--r-- | src/vhdl/sem_expr.adb | 210 | ||||
-rw-r--r-- | src/vhdl/sem_names.adb | 241 | ||||
-rw-r--r-- | src/vhdl/sem_psl.adb | 32 | ||||
-rw-r--r-- | src/vhdl/sem_scopes.adb | 14 | ||||
-rw-r--r-- | src/vhdl/sem_specs.adb | 152 | ||||
-rw-r--r-- | src/vhdl/sem_stmts.adb | 178 | ||||
-rw-r--r-- | src/vhdl/sem_types.adb | 202 | ||||
-rw-r--r-- | src/vhdl/simulate/elaboration.adb | 7 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap1.adb | 2 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap3.adb | 3 | ||||
-rw-r--r-- | src/vhdl/translate/trans_be.adb | 2 | ||||
-rw-r--r-- | src/vhdl/translate/translation.adb | 10 |
24 files changed, 924 insertions, 940 deletions
diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb index 9249f2cfb..94d760d63 100644 --- a/src/ghdldrv/ghdlrun.adb +++ b/src/ghdldrv/ghdlrun.adb @@ -175,8 +175,8 @@ package body Ghdlrun is if Res /= Null_Address then Def (Ortho, Res); else - Error_Msg_Sem ("unknown foreign VHPIDIRECT '" & Name & "'", - Decl); + Error_Msg_Sem + (+Decl, "unknown foreign VHPIDIRECT '" & Name & "'"); end if; end; when Foreign_Intrinsic => @@ -192,8 +192,8 @@ package body Ghdlrun is elsif Name = "get_resolution_limit" then Def (Ortho, Grt.Lib.Ghdl_Get_Resolution_Limit'Address); else - Error_Msg_Sem ("unknown foreign intrinsic '" & Name & "'", - Decl); + Error_Msg_Sem + (+Decl, "unknown foreign intrinsic %i", +Decl); end if; end; when Foreign_Unknown => diff --git a/src/libraries.adb b/src/libraries.adb index 0a91dbc8c..7a24fe0c8 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -751,8 +751,7 @@ package body Libraries is Set_Library_Directory (Library, Null_Identifier); Set_Identifier (Library, Ident); if Load_Library (Library) = False then - Error_Msg_Sem ("cannot find resource library """ - & Name_Table.Image (Ident) & """", Loc); + Error_Msg_Sem (+Loc, "cannot find resource library %i", +Ident); end if; Set_Visible_Flag (Library, True); @@ -1469,13 +1468,24 @@ package body Libraries is function Is_Obsolete (Design_Unit : Iir_Design_Unit; Loc : Iir) return Boolean is - procedure Error_Obsolete (Msg : String) is + procedure Error_Obsolete (Msg : String; Arg1 : Earg_Type) is begin if not Flags.Flag_Elaborate_With_Outdated then if Loc = Null_Iir then - Error_Msg_Sem (Msg, Command_Line_Location); + Error_Msg_Sem (Command_Line_Location, Msg, Arg1); else - Error_Msg_Sem (Msg, Loc); + Error_Msg_Sem (+Loc, Msg, Arg1); + end if; + end if; + end Error_Obsolete; + + procedure Error_Obsolete (Msg : String; Args : Earg_Arr) is + begin + if not Flags.Flag_Elaborate_With_Outdated then + if Loc = Null_Iir then + Error_Msg_Sem (Command_Line_Location, Msg, Args); + else + Error_Msg_Sem (+Loc, Msg, Args); end if; end if; end Error_Obsolete; @@ -1487,7 +1497,7 @@ package body Libraries is Du_Ts : Time_Stamp_Id; begin if Get_Date (Design_Unit) = Date_Obsolete then - Error_Obsolete (Disp_Node (Design_Unit) & " is obsolete"); + Error_Obsolete ("%n is obsolete", +Design_Unit); return True; end if; List := Get_Dependence_List (Design_Unit); @@ -1502,13 +1512,10 @@ package body Libraries is if Unit /= Null_Iir then U_Ts := Get_Analysis_Time_Stamp (Get_Design_File (Unit)); if Files_Map.Is_Gt (U_Ts, Du_Ts) then - Error_Obsolete - (Disp_Node (Design_Unit) & " is obsoleted by " & - Disp_Node (Unit)); + Error_Obsolete ("%n is obsoleted by %n", (+Design_Unit, +Unit)); return True; elsif Is_Obsolete (Unit, Loc) then - Error_Obsolete - (Disp_Node (Design_Unit) & " depends on obsolete unit"); + Error_Obsolete ("%n depends on obsolete unit", +Design_Unit); return True; end if; end if; @@ -1544,15 +1551,12 @@ package body Libraries is (Files_Map.Get_File_Checksum (Get_Current_Source_File), Get_File_Checksum (Design_File)) then - Error_Msg_Sem - ("file " & Image (Get_Design_File_Filename (Design_File)) - & " has changed and must be reanalysed", Loc); + Error_Msg_Sem (+Loc, "file %i has changed and must be reanalysed", + +Get_Design_File_Filename (Design_File)); raise Compilation_Error; elsif Get_Date (Design_Unit) = Date_Obsolete then - Error_Msg_Sem - (''' & Disp_Node (Get_Library_Unit (Design_Unit)) - & "' is not anymore in the file", - Design_Unit); + Error_Msg_Sem (+Design_Unit, "%n is not anymore its source file", + +Get_Library_Unit (Design_Unit)); raise Compilation_Error; end if; Pos := Get_Design_Unit_Source_Pos (Design_Unit); @@ -1619,7 +1623,7 @@ package body Libraries is null; when Date_Obsolete => if not Flags.Flag_Elaborate_With_Outdated then - Error_Msg_Sem (Disp_Node (Design_Unit) & " is obsolete", Loc); + Error_Msg_Sem (+Loc, "%n is obsolete", +Design_Unit); return; end if; when others => 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; |