Skip to content

Commit

Permalink
Fix cascade IO crashes after unexpected error
Browse files Browse the repository at this point in the history
If output file is open when an unexpected error happens, close it.

fixes eng/ide/libadalang-tools#148
  • Loading branch information
fedor-rybin committed Mar 4, 2024
1 parent fce7ce5 commit 238fc32
Show file tree
Hide file tree
Showing 14 changed files with 56 additions and 1 deletion.
4 changes: 3 additions & 1 deletion src/test-common.adb
Original file line number Diff line number Diff line change
Expand Up @@ -861,7 +861,9 @@ package body Test.Common is

procedure Close_File is
begin
Char_Sequential_IO.Close (Output_File);
if Char_Sequential_IO.Is_Open (Output_File) then
Char_Sequential_IO.Close (Output_File);
end if;
end Close_File;

------------------
Expand Down
2 changes: 2 additions & 0 deletions src/test-skeleton.adb
Original file line number Diff line number Diff line change
Expand Up @@ -578,6 +578,8 @@ package body Test.Skeleton is
Suite_Data.TR_List.Clear;
Suite_Data.ITR_List.Clear;
Suite_Data.LTR_List.Clear;

Close_File;
end Cleanup;

----------------------------
Expand Down
2 changes: 2 additions & 0 deletions src/test-stub.adb
Original file line number Diff line number Diff line change
Expand Up @@ -369,6 +369,8 @@ package body Test.Stub is
Data.Elem_Tree.Clear;
Data.Flat_List.Clear;
Data.Limited_Withed_Units.Clear;

Close_File;
end Cleanup;

------------------------
Expand Down
6 changes: 6 additions & 0 deletions testsuite/tests/test/error_recovery/importing.ads
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
with Wrong_1;
with Wrong_2;
with Right;
package Importing is
function F return Integer is (1);
end importing;
2 changes: 2 additions & 0 deletions testsuite/tests/test/error_recovery/p.gpr
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
project p is
end p;
6 changes: 6 additions & 0 deletions testsuite/tests/test/error_recovery/right.adb
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
package body Right is
function F return String is
begin
return "foo";
end F;
end Right;
3 changes: 3 additions & 0 deletions testsuite/tests/test/error_recovery/right.ads
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
package Right is
function F return String;
end Right;
4 changes: 4 additions & 0 deletions testsuite/tests/test/error_recovery/test.out
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
gnattest: name resolution error for <Id "Some_Type" wrong_1.ads:3:56-3:65>
gnattest: unexpected error while creating stub for wrong_1.ads
gnattest: name resolution error for <Id "Some_Type" wrong_2.ads:3:46-3:55>
gnattest: unexpected error while creating stub for wrong_2.ads
3 changes: 3 additions & 0 deletions testsuite/tests/test/error_recovery/test.sh
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
#!/bin/bash

GNATTEST_STRICT=False gnattest -P p --stub importing.ads -q
5 changes: 5 additions & 0 deletions testsuite/tests/test/error_recovery/test.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
description:
Test error recovery

driver: shell_script

6 changes: 6 additions & 0 deletions testsuite/tests/test/error_recovery/wrong_1.adb
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
package body Wrong_1 is
procedure Cannot_Stub (X : in out Missing.Something.Some_Type) is
begin
null;
end Cannot_Stub;
end Wrong_1;
4 changes: 4 additions & 0 deletions testsuite/tests/test/error_recovery/wrong_1.ads
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
with Missing.Something;
package Wrong_1 is
procedure Cannot_Stub (X : in out Missing.Something.Some_Type);
end Wrong_1;
6 changes: 6 additions & 0 deletions testsuite/tests/test/error_recovery/wrong_2.adb
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
package body Wrong_2 is
procedure Cannot_Stub (X : in out Missing.Some_Type) is
begin
null;
end Cannot_Stub;
end Wrong_2;
4 changes: 4 additions & 0 deletions testsuite/tests/test/error_recovery/wrong_2.ads
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
with Missing;
package Wrong_2 is
procedure Cannot_Stub (X : in out Missing.Some_Type);
end Wrong_2;

0 comments on commit 238fc32

Please sign in to comment.