diff options
Diffstat (limited to 'xtools/check_iirs_pkg.adb')
| -rw-r--r-- | xtools/check_iirs_pkg.adb | 59 |
1 files changed, 37 insertions, 22 deletions
diff --git a/xtools/check_iirs_pkg.adb b/xtools/check_iirs_pkg.adb index d0f5818..72781bb 100644 --- a/xtools/check_iirs_pkg.adb +++ b/xtools/check_iirs_pkg.adb @@ -505,6 +505,7 @@ package body Check_Iirs_Pkg is Line := Get_Line (In_Iirs); if not Match (Line, Start_Range_Pat) then -- Bad pattern for left bound. + Put_Line (Standard_Error, "bad pattern"); raise Err; end if; Start := Get_Iir_Pos (Ident); @@ -520,7 +521,7 @@ package body Check_Iirs_Pkg is if Match (Line, End_Range_Pat) then P := Get_Iir_Pos (Ident); if P /= Pos + 1 and then Flag_Disp_Subtype Then - Put_Line ("** missing comments"); + Put_Line (Standard_Error, "** missing comments"); for I in Pos + 1 .. P - 1 loop Put_Line (" --" & Iir_Table.Table (I).Name.all); end loop; @@ -534,6 +535,7 @@ package body Check_Iirs_Pkg is P := Get_Iir_Pos (Ident); if P /= Pos + 1 then -- Bad order. + Put_Line (Standard_Error, "** missing node in range"); raise Err; else Pos := Pos + 1; @@ -552,7 +554,8 @@ package body Check_Iirs_Pkg is begin Field_Pos := Get (Field2pos, Ident); if Field_Pos < 0 then - Put_Line ("*** field not found: '" & S (Ident) & "'"); + Put_Line (Standard_Error, + "*** field not found: '" & S (Ident) & "'"); raise Err; end if; @@ -562,7 +565,7 @@ package body Check_Iirs_Pkg is elsif Ident_2 = "uc" then Conv := Via_Unchecked; else - Put_Line ("*** bad conversion"); + Put_Line (Standard_Error, "*** bad conversion"); raise Err; end if; else @@ -571,7 +574,7 @@ package body Check_Iirs_Pkg is Line := Get_Line (In_Iirs); if not Match (Line, Function_Get_Pat) then - Put_Line ("*** function expected"); + Put_Line (Standard_Error, "*** function expected"); raise Err; end if; @@ -595,24 +598,28 @@ package body Check_Iirs_Pkg is Line := Get_Line (In_Iirs); if Match (Line, Procedure_Set_Pat) then if Func_Table.Table (F).Target_Name.all /= Ident_2 then - Put_Line ("*** procedure target name mismatch (" + Put_Line (Standard_Error, + "*** procedure target name mismatch (" & Func_Table.Table (F).Target_Name.all & " vs " & S (Ident_2) &")"); raise Err; end if; if Func_Table.Table (F).Target_Type.all /= Ident_3 then - Put_Line ("*** procedure target type name mismatch"); + Put_Line (Standard_Error, + "*** procedure target type name mismatch"); raise Err; end if; if Func_Table.Table (F).Value_Type.all /= Ident_5 then - Put_Line ("*** procedure target type name mismatch"); + Put_Line (Standard_Error, + "*** procedure target type name mismatch"); raise Err; end if; Func_Table.Table (F).Value_Name := new String'(To_String (Ident_4)); else if not Match (Line, Rpos (0)) then - Put_Line ("*** procedure or empty line expected"); + Put_Line (Standard_Error, + "*** procedure or empty line expected"); raise Err; end if; end if; @@ -623,7 +630,8 @@ package body Check_Iirs_Pkg is Set_Exit_Status (Success); exception when Err => - Put_Line ("*** Fatal error at line" + Put_Line (Standard_Error, + "*** Fatal error at line" & Positive_Count'Image (Ada.Text_IO.Line (In_Iirs))); Set_Exit_Status (Failure); raise; @@ -778,12 +786,13 @@ package body Check_Iirs_Pkg is -- Check format. if Ident_2 = Nul then - Put_Line ("*** no format for " & S (Ident)); + Put_Line (Standard_Error, + "*** no format for " & S (Ident)); raise Err; end if; P_Num := Get (Format2pos, Ident_2); if P_Num < 0 then - Put_Line ("*** unknown format"); + Put_Line (Standard_Error, "*** unknown format"); raise Err; end if; Format := Format_Type (P_Num); @@ -795,7 +804,7 @@ package body Check_Iirs_Pkg is else Rng := Get (Iir_Kinds2pos, Ident); if Rng = Null_Range then - Put_Line ("*** " & S (Ident)); + Put_Line (Standard_Error, "*** " & S (Ident)); raise Err; end if; for I in Rng.L .. Rng.H loop @@ -834,13 +843,14 @@ package body Check_Iirs_Pkg is if not Field_Table.Table (Field). Formats (Iir_Table.Table (N).Format) then - Put_Line ("** no field for format"); + Put_Line (Standard_Error, "** no field for format"); raise Err; end if; if Is_Alias then if Iir_Table.Table (N).Func (Field) = No_Func then - Put_Line ("** aliased field not yet used"); + Put_Line (Standard_Error, + "** aliased field not yet used"); raise Err; end if; else @@ -848,7 +858,8 @@ package body Check_Iirs_Pkg is --and then --Iir_Table.Table (N).Func (Field) /= Func then - Put_Line ("** Field already used"); + Put_Line (Standard_Error, + "** Field already used"); raise Err; end if; Iir_Table.Table (N).Func (Field) := Func; @@ -879,7 +890,8 @@ package body Check_Iirs_Pkg is end if; Field_Num := Get (Field2pos, Ident); if Field_Num < 0 then - Put_Line ("*** unknown field: " & S (Ident)); + Put_Line (Standard_Error, + "*** unknown field: " & S (Ident)); raise Err; end if; Field := Field_Type (Field_Num); @@ -920,7 +932,8 @@ package body Check_Iirs_Pkg is return; end if; end loop; - Put_Line ("** not currently described"); + Put_Line (Standard_Error, + "** not currently described"); raise Err; end Add_Only_For; begin @@ -930,7 +943,7 @@ package body Check_Iirs_Pkg is else Rng := Get (Iir_Kinds2pos, Ident); if Rng = Null_Range then - Put_Line ("*** " & S (Ident)); + Put_Line (Standard_Error, "*** " & S (Ident)); raise Err; end if; for I in Rng.L .. Rng.H loop @@ -939,7 +952,7 @@ package body Check_Iirs_Pkg is end if; end; elsif Match (Line, " -- Only") then - Put_Line ("** bad only for line"); + Put_Line (Standard_Error, "** bad 'Only' for line"); raise Err; elsif Match (Line, Desc_Comment_Pat) then null; @@ -959,7 +972,8 @@ package body Check_Iirs_Pkg is -- Check each Iir was described. for I in Iir_Table.First .. Iir_Table.Last loop if not Iir_Table.Table (I).Described then - Put_Line ("*** not described: " & Iir_Table.Table (I).Name.all); + Put_Line (Standard_Error, + "*** not described: " & Iir_Table.Table (I).Name.all); raise Err; end if; end loop; @@ -967,9 +981,10 @@ package body Check_Iirs_Pkg is Close (In_Iirs); exception when Err => - Put_Line ("*** Fatal error at line" + Put_Line (Standard_Error, + "*** Fatal error (2) at line" & Positive_Count'Image (Ada.Text_IO.Line (In_Iirs) - 1)); - Put_Line ("*** Line is " & S (Line)); + Put_Line (Standard_Error, "*** Line is " & S (Line)); Set_Exit_Status (Failure); raise; end Read_Desc; |