From fb395d6c9ea0188cbc50efb0354c20f312385039 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= Date: Fri, 29 Mar 2024 10:58:27 +0100 Subject: [PATCH] Improve the quality of nameres tests This change introduces a new argument that can be used for the nameres `Test_Statement` and `Test_Statement_UID` pragmas. This boolean argument, named `Expect_Fail` can be set to check that a given statement is failing as expected. This change also removes the support of the unused and not functioning pragma XFAIL_Nameres. --- testsuite/ada/nameres.adb | 149 ++++++++++-------- .../W117-011_many_accesses/test.adb | 2 +- .../W117-011_many_accesses/test.out | 2 + .../name_resolution/exit_stmt/exit_stmt.adb | 2 +- .../tests/name_resolution/exit_stmt/test.out | 2 + .../name_resolution/generic_equality/main.adb | 2 +- .../name_resolution/generic_equality/test.out | 2 + .../generic_pkg_inst_5/foo.adb | 2 +- .../generic_pkg_inst_5/test.out | 2 + .../name_resolution/late_use_clause/test.out | 32 +++- .../late_use_clause/testuse.adb | 1 + .../non_visible_dependency/test.adb | 2 +- .../non_visible_dependency/test.out | 2 + .../name_resolution/stmt_object_decl/test.adb | 2 +- .../name_resolution/stmt_object_decl/test.out | 2 + .../name_resolution/test_expect_fail/test.adb | 29 ++++ .../name_resolution/test_expect_fail/test.out | 57 +++++++ .../test_expect_fail/test.yaml | 2 + .../use_bool_derived_type/test.out | 8 + .../use_bool_derived_type/test_invalid.adb | 6 +- .../use_bool_derived_type/test_task.adb | 2 +- .../xref_eq_aggregates_1/simple_aggregate.adb | 2 +- .../xref_eq_aggregates_1/test.out | 2 + .../derived_aggregate.adb | 2 +- .../xref_eq_aggregates_2/test.out | 2 + .../xref_eq_chr_literal/test.out | 2 + .../xref_eq_chr_literal/testchrlit.adb | 2 +- .../xref_eq_enum_literals/enum_types.adb | 2 +- .../xref_eq_enum_literals/test.out | 2 + .../xref_eq_proc_call_2/test.adb | 2 +- .../xref_eq_proc_call_2/test.out | 2 + .../xref_eq_recursive_callexpr_2/test.adb | 2 +- .../xref_eq_recursive_callexpr_2/test.out | 2 + .../xref_eq_string_literals/test.out | 2 + .../xref_eq_string_literals/teststrlit.adb | 2 +- 35 files changed, 256 insertions(+), 82 deletions(-) create mode 100644 testsuite/tests/name_resolution/test_expect_fail/test.adb create mode 100644 testsuite/tests/name_resolution/test_expect_fail/test.out create mode 100644 testsuite/tests/name_resolution/test_expect_fail/test.yaml diff --git a/testsuite/ada/nameres.adb b/testsuite/ada/nameres.adb index 3fb845885..a771cbbca 100644 --- a/testsuite/ada/nameres.adb +++ b/testsuite/ada/nameres.adb @@ -295,20 +295,21 @@ procedure Nameres is Test_Debug : Boolean; when Pragma_Test_Statement - | Pragma_Test_Statement_UID - | Pragma_Test_Block - => + | Pragma_Test_Statement_UID => -- Run name resolution on the statement that precedes this pragma. -- -- For the UID version, but show the unique_identifying name of -- the declarations instead of the node image. This is used in -- case the node might change (for example in tests where we -- resolve runtime things). - -- - -- For the block version, run name resolution on all xref entry - -- points in the statement that precedes this pragma, or on the - -- whole compilation unit if top-level. - Test_Target : Ada_Node; + Target_Stmt : Ada_Node; + Expect_Fail : Boolean; + + when Pragma_Test_Block => + -- Run name resolution on all xref entry points in the statement + -- that precedes this pragma, or on the whole compilation unit if + -- top-level. + Target_Block : Ada_Node; when Pragma_Find_All_References => -- Run the find-all-references property designated by Refs_Kind on @@ -404,7 +405,10 @@ procedure Nameres is Name : constant String := Text (Node.F_Id); Untyped_Args : constant Ada_Node_Array := Node.F_Args.Children; - Args : array (Untyped_Args'Range) of Pragma_Argument_Assoc; + + type Args_Array is array (Untyped_Args'Range) of Pragma_Argument_Assoc; + + Args : Args_Array; function Error (Message : String) return Decoded_Pragma is ((Error_In_Pragma, Start_Sloc (Node.Sloc_Range), +Message)); @@ -419,6 +423,51 @@ procedure Nameres is & " pragma arguments, got" & Args'Length'Image)); -- Return an Error_In_Pragma record for an unexpected number of pragma -- arguments. + function Decode_Pragma_With_Expect_Fail_Argument + (Kind : Supported_Pragma; + Target : Ada_Node; + Args : Args_Array) return Decoded_Pragma; + -- Decode a Pragma that can have one `Expect_Fail` argument (i.e. + -- Test_Statement or Test_Statement_UID). + + --------------------------------------------- + -- Decode_Pragma_With_Expect_Fail_Argument -- + --------------------------------------------- + + function Decode_Pragma_With_Expect_Fail_Argument + (Kind : Supported_Pragma; + Target : Ada_Node; + Args : Args_Array) return Decoded_Pragma + is + Expect_Fail : Boolean := False; + begin + if Args'Length not in 0 .. 1 then + return N_Args_Error (0, 1); + end if; + + if Args'Length = 1 then + declare + pragma Assert (Args (1).F_Name.Kind = Ada_Identifier); + Name : constant Text_Type := Args (1).F_Name.Text; + Expr : constant Text_Type := Args (1).F_Expr.Text; + begin + if Name = "Expect_Fail" then + Expect_Fail := Decode_Boolean_Literal (Expr); + else + return Error ("Expect `Expect_Fail` argument, got: " + & Image (Name)); + end if; + end; + end if; + + if Kind = Pragma_Test_Statement then + return (Pragma_Test_Statement, Target, Expect_Fail); + elsif Kind = Pragma_Test_Statement_UID then + return (Pragma_Test_Statement_UID, Target, Expect_Fail); + else + return Error ("Unsupported pragma kind: " & Kind'Image); + end if; + end Decode_Pragma_With_Expect_Fail_Argument; begin for I in Untyped_Args'Range loop @@ -482,16 +531,12 @@ procedure Nameres is end; elsif Name = "Test_Statement" then - if Args'Length /= 0 then - return N_Args_Error (0); - end if; - return (Pragma_Test_Statement, Node.Previous_Sibling); + return Decode_Pragma_With_Expect_Fail_Argument + (Pragma_Test_Statement, Node.Previous_Sibling, Args); elsif Name = "Test_Statement_UID" then - if Args'Length /= 0 then - return N_Args_Error (0); - end if; - return (Pragma_Test_Statement_UID, Node.Previous_Sibling); + return Decode_Pragma_With_Expect_Fail_Argument + (Pragma_Test_Statement_UID, Node.Previous_Sibling, Args); elsif Name = "Test_Block" then if Args'Length /= 0 then @@ -817,7 +862,8 @@ procedure Nameres is procedure Resolve_Node (Node : Ada_Node; Show_Slocs : Boolean := True; - In_Generic_Instantiation : Boolean := False); + In_Generic_Instantiation : Boolean := False; + Expect_Fail : Boolean := False); -- Run name resolution testing on Node. -- -- This involves running P_Resolve_Names on Node, displaying resolved @@ -902,12 +948,13 @@ procedure Nameres is Trigger_Envs_Debug (False); when Pragma_Test_Statement | Pragma_Test_Statement_UID => - Resolve_Node (Node => P.Test_Target, - Show_Slocs => P.Kind /= Pragma_Test_Statement_UID); + Resolve_Node (Node => P.Target_Stmt, + Show_Slocs => P.Kind /= Pragma_Test_Statement_UID, + Expect_Fail => P.Expect_Fail); Empty := False; when Pragma_Test_Block => - Resolve_Block (P.Test_Target); + Resolve_Block (P.Target_Block, False); Empty := False; when Pragma_Find_All_References => @@ -958,11 +1005,8 @@ procedure Nameres is procedure Resolve_Node (Node : Ada_Node; Show_Slocs : Boolean := True; - In_Generic_Instantiation : Boolean := False) is - - function XFAIL return Boolean; - -- If there is an XFAIL pragma for the node being resolved, show the - -- message, and return True. + In_Generic_Instantiation : Boolean := False; + Expect_Fail : Boolean := False) is function Print_Node (N : Ada_Node'Class) return Visit_Status; -- Callback for the tree traversal in Node. Print xref info for N. @@ -1028,34 +1072,6 @@ procedure Nameres is else Into); end Print_Node; - ----------- - -- XFAIL -- - ----------- - - function XFAIL return Boolean is - N : constant Ada_Node := Next_Sibling (Node); - begin - if not Is_Null (N) and then Kind (N) = Ada_Pragma_Node then - if Child (N, 1).Text = "XFAIL_Nameres" then - declare - Arg : constant String_Literal := - N.As_Pragma_Node.F_Args.Child (1) - .As_Base_Assoc.P_Assoc_Expr.As_String_Literal; - begin - if Arg.Is_Null then - raise Program_Error - with "Invalid arg for " & N.Image; - end if; - Put_Line ("XFAIL: " & Image (Arg.P_Denoted_Value, False)); - Put_Line (""); - end; - return True; - end if; - return False; - end if; - return False; - end XFAIL; - Verbose : constant Boolean := not (Quiet or else Args.Only_Show_Failures.Get); Output_JSON : constant Boolean := Args.JSON.Get; @@ -1082,21 +1098,34 @@ procedure Nameres is -- Perform name resolution if P_Resolve_Names (Node) or else Args.Imprecise_Fallback.Get then + if Expect_Fail then + if not Quiet then + Put_Line + ("A failure was expected but name resolution succeeded:"); + Put_Line (""); + end if; + Increment (Stats.Nb_Fails); + else + Increment (Stats.Nb_Successes); + end if; + if not Args.Only_Show_Failures.Get then Dummy := Traverse (Node, Print_Node'Access); end if; - Increment (Stats.Nb_Successes); - if Output_JSON then Obj.Set_Field ("success", True); end if; else if not Quiet then + if Expect_Fail then + Put_Line ("Name resolution failed as expected with:"); + Put_Line (""); + end if; Emit_Diagnostics (Node, P_Nameres_Diagnostics (Node)); end if; - if XFAIL then + if Expect_Fail then Increment (Stats.Nb_Xfails); else Increment (Stats.Nb_Fails); @@ -1156,11 +1185,7 @@ procedure Nameres is ("Resolution failed with exception for node " & Node.Image); Dump_Exception (E, Obj); - if XFAIL then - Increment (Stats.Nb_Xfails); - else - Increment (Stats.Nb_Fails); - end if; + Increment (Stats.Nb_Fails); end Resolve_Node; begin diff --git a/testsuite/tests/name_resolution/W117-011_many_accesses/test.adb b/testsuite/tests/name_resolution/W117-011_many_accesses/test.adb index f662bd307..dc3416d78 100644 --- a/testsuite/tests/name_resolution/W117-011_many_accesses/test.adb +++ b/testsuite/tests/name_resolution/W117-011_many_accesses/test.adb @@ -11,7 +11,7 @@ procedure Test is F'Access & G'Access & H'Access; - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); begin null; end Test; diff --git a/testsuite/tests/name_resolution/W117-011_many_accesses/test.out b/testsuite/tests/name_resolution/W117-011_many_accesses/test.out index e13ee4510..63cdde286 100644 --- a/testsuite/tests/name_resolution/W117-011_many_accesses/test.out +++ b/testsuite/tests/name_resolution/W117-011_many_accesses/test.out @@ -4,6 +4,8 @@ Analyzing test.adb Resolving xrefs for node ************************************************************** +Name resolution failed as expected with: + test.adb:12:7: error: expected , got 12 | G'Access & | ^^^^^^^^ diff --git a/testsuite/tests/name_resolution/exit_stmt/exit_stmt.adb b/testsuite/tests/name_resolution/exit_stmt/exit_stmt.adb index bde17def1..6494bdfe9 100644 --- a/testsuite/tests/name_resolution/exit_stmt/exit_stmt.adb +++ b/testsuite/tests/name_resolution/exit_stmt/exit_stmt.adb @@ -11,7 +11,7 @@ begin pragma Section ("Incorrect case"); exit when Bar; - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); end loop; pragma Section ("Exit with fully qualified name"); diff --git a/testsuite/tests/name_resolution/exit_stmt/test.out b/testsuite/tests/name_resolution/exit_stmt/test.out index c964d1b9b..5f6194b9a 100644 --- a/testsuite/tests/name_resolution/exit_stmt/test.out +++ b/testsuite/tests/name_resolution/exit_stmt/test.out @@ -18,6 +18,8 @@ Incorrect case Resolving xrefs for node ************************************************************ +Name resolution failed as expected with: + exit_stmt.adb:13:17: error: expected boolean type, got Integer 13 | exit when Bar; | ^^^ diff --git a/testsuite/tests/name_resolution/generic_equality/main.adb b/testsuite/tests/name_resolution/generic_equality/main.adb index 9634341de..65f2003c0 100644 --- a/testsuite/tests/name_resolution/generic_equality/main.adb +++ b/testsuite/tests/name_resolution/generic_equality/main.adb @@ -14,5 +14,5 @@ begin pragma Test_Statement; V := V4; - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); end Main; diff --git a/testsuite/tests/name_resolution/generic_equality/test.out b/testsuite/tests/name_resolution/generic_equality/test.out index 56ae1aa07..7a226de67 100644 --- a/testsuite/tests/name_resolution/generic_equality/test.out +++ b/testsuite/tests/name_resolution/generic_equality/test.out @@ -28,6 +28,8 @@ Expr: Resolving xrefs for node ********************************************************* +Name resolution failed as expected with: + main.adb:16:9: error: expected Vector [instance at line 4], got Vector [instance at line 5] 16 | V := V4; | ^^ diff --git a/testsuite/tests/name_resolution/generic_pkg_inst_5/foo.adb b/testsuite/tests/name_resolution/generic_pkg_inst_5/foo.adb index 0d5866a9f..9600738b8 100644 --- a/testsuite/tests/name_resolution/generic_pkg_inst_5/foo.adb +++ b/testsuite/tests/name_resolution/generic_pkg_inst_5/foo.adb @@ -7,5 +7,5 @@ procedure Foo is X : Int1_Opt.Opt_Type; begin X := Int2_Opt.Create; - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); end Foo; diff --git a/testsuite/tests/name_resolution/generic_pkg_inst_5/test.out b/testsuite/tests/name_resolution/generic_pkg_inst_5/test.out index 9b79988c4..2eee27d90 100644 --- a/testsuite/tests/name_resolution/generic_pkg_inst_5/test.out +++ b/testsuite/tests/name_resolution/generic_pkg_inst_5/test.out @@ -4,6 +4,8 @@ Analyzing foo.adb Resolving xrefs for node ****************************************************** +Name resolution failed as expected with: + foo.adb:9:9: error: expected Opt_Type [instance at line 4], got Opt_Type [instance at line 5] 9 | X := Int2_Opt.Create; | ^^^^^^^^^^^^^^^ diff --git a/testsuite/tests/name_resolution/late_use_clause/test.out b/testsuite/tests/name_resolution/late_use_clause/test.out index 9367d1145..553381f2f 100644 --- a/testsuite/tests/name_resolution/late_use_clause/test.out +++ b/testsuite/tests/name_resolution/late_use_clause/test.out @@ -1,6 +1,16 @@ Analyzing testuse.adb ##################### +Resolving xrefs for node +****************************************************************** + +Name resolution failed as expected with: + +testuse.adb:14:20: error: expected Float, got Integer +14 | C : Float := Foo; + | ^^^ + + Resolving xrefs for node ****************************************************************** @@ -9,15 +19,31 @@ testuse.adb:14:20: error: expected Float, got Integer | ^^^ -Resolving xrefs for node +Resolving xrefs for node +************************************************************ + +Expr: + references: None + type: None + expected type: None +Expr: + references: None + type: None + expected type: None +Expr: + references: + type: + expected type: None + +Resolving xrefs for node ****************************************************************** -Expr: +Expr: references: type: None expected type: None -Resolving xrefs for node +Resolving xrefs for node ********************************************************** diff --git a/testsuite/tests/name_resolution/late_use_clause/testuse.adb b/testsuite/tests/name_resolution/late_use_clause/testuse.adb index 80f1b5681..ef5579ff3 100644 --- a/testsuite/tests/name_resolution/late_use_clause/testuse.adb +++ b/testsuite/tests/name_resolution/late_use_clause/testuse.adb @@ -12,6 +12,7 @@ procedure Testuse is begin declare C : Float := Foo; + pragma Test_Statement (Expect_Fail => True); use B; begin null; diff --git a/testsuite/tests/name_resolution/non_visible_dependency/test.adb b/testsuite/tests/name_resolution/non_visible_dependency/test.adb index be35c84ad..75ad95251 100644 --- a/testsuite/tests/name_resolution/non_visible_dependency/test.adb +++ b/testsuite/tests/name_resolution/non_visible_dependency/test.adb @@ -1,5 +1,5 @@ procedure Test is begin Foo.Bar; - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); end Test; diff --git a/testsuite/tests/name_resolution/non_visible_dependency/test.out b/testsuite/tests/name_resolution/non_visible_dependency/test.out index a349968dc..a164569a8 100644 --- a/testsuite/tests/name_resolution/non_visible_dependency/test.out +++ b/testsuite/tests/name_resolution/non_visible_dependency/test.out @@ -7,6 +7,8 @@ Analyzing test.adb Resolving xrefs for node ***************************************************** +Name resolution failed as expected with: + test.adb:3:4: error: no such entity 3 | Foo.Bar; | ^^^ diff --git a/testsuite/tests/name_resolution/stmt_object_decl/test.adb b/testsuite/tests/name_resolution/stmt_object_decl/test.adb index c6b26b39c..f506740b0 100644 --- a/testsuite/tests/name_resolution/stmt_object_decl/test.adb +++ b/testsuite/tests/name_resolution/stmt_object_decl/test.adb @@ -13,7 +13,7 @@ begin -- Sequential visibility test: This should fail because C is not declared -- yet. Put_Line (Integer'Image (A + B + C)); - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); -- Renamings test: this should work C : Integer renames B; diff --git a/testsuite/tests/name_resolution/stmt_object_decl/test.out b/testsuite/tests/name_resolution/stmt_object_decl/test.out index 34a703a60..3d13bb70f 100644 --- a/testsuite/tests/name_resolution/stmt_object_decl/test.out +++ b/testsuite/tests/name_resolution/stmt_object_decl/test.out @@ -47,6 +47,8 @@ Expr: Resolving xrefs for node ******************************************************* +Name resolution failed as expected with: + test.adb:15:37: error: no such entity 15 | Put_Line (Integer'Image (A + B + C)); | ^ diff --git a/testsuite/tests/name_resolution/test_expect_fail/test.adb b/testsuite/tests/name_resolution/test_expect_fail/test.adb new file mode 100644 index 000000000..37f5ff334 --- /dev/null +++ b/testsuite/tests/name_resolution/test_expect_fail/test.adb @@ -0,0 +1,29 @@ +procedure Test is + type Int is range 1 .. 110; + function C (I : Int) return Int; + + B : Int; +begin + B := C (12); + pragma Test_Statement (Expect_Fail => True); + -- Check nameres output assuming this statement resolution is expected to + -- fail (this is not the case, it's just for testing purpose). + + B := C (12); + pragma Test_Statement (Expect_Fial => True); + -- Check that unsupported argument are rejected + + C (12); + pragma Test_Statement (Expect_Fail => True); + -- Check that this statement's resolution fail, and reported as expected + + C (12); + pragma Test_Statement (Expect_Fail => False); + -- Check that nameres report a failure when resolving this statement + + C (12); + pragma Test_Statement_UID (Expect_Fail => True); + -- Check that this statement's resolution fail, and reported as expected +end Test; +pragma Test_Block (Expect_Fail => True); +-- Check that Expect_Fail is not supported for pragma Test_Block diff --git a/testsuite/tests/name_resolution/test_expect_fail/test.out b/testsuite/tests/name_resolution/test_expect_fail/test.out new file mode 100644 index 000000000..83cef438b --- /dev/null +++ b/testsuite/tests/name_resolution/test_expect_fail/test.out @@ -0,0 +1,57 @@ +Analyzing test.adb +################## + +Resolving xrefs for node +******************************************************* + +A failure was expected but name resolution succeeded: + +Expr: + references: + type: + expected type: None +Expr: + references: + type: + expected type: +Expr: + references: + type: + expected type: None +Expr: + references: None + type: + expected type: + +13:4: Expect `Expect_Fail` argument, got: Expect_Fial +Resolving xrefs for node +******************************************************* + +Name resolution failed as expected with: + +test.adb:16:4: error: resolution failed +16 | C (12); + | ^^^^^^^ + + +Resolving xrefs for node +******************************************************* + +test.adb:20:4: error: resolution failed +20 | C (12); + | ^^^^^^^ + + +Resolving xrefs for node +******************************************************* + +Name resolution failed as expected with: + +test.adb:24:4: error: resolution failed +24 | C (12); + | ^^^^^^^ + + +28:1: expected 0 pragma arguments, got 1 + +Done. diff --git a/testsuite/tests/name_resolution/test_expect_fail/test.yaml b/testsuite/tests/name_resolution/test_expect_fail/test.yaml new file mode 100644 index 000000000..173e325ff --- /dev/null +++ b/testsuite/tests/name_resolution/test_expect_fail/test.yaml @@ -0,0 +1,2 @@ +driver: name-resolution +input_sources: [test.adb] diff --git a/testsuite/tests/name_resolution/use_bool_derived_type/test.out b/testsuite/tests/name_resolution/use_bool_derived_type/test.out index 3a690c401..bcb212606 100644 --- a/testsuite/tests/name_resolution/use_bool_derived_type/test.out +++ b/testsuite/tests/name_resolution/use_bool_derived_type/test.out @@ -272,6 +272,8 @@ test_invalid.adb:8:46: error: expected Boolean, got My_Bool Resolving xrefs for node ***************************************************************** +Name resolution failed as expected with: + test_invalid.adb:12:17: error: no such entity 12 | pragma Post (Foo, X and not Y); | ^^^ @@ -280,6 +282,8 @@ test_invalid.adb:12:17: error: no such entity Resolving xrefs for node ***************************************************************** +Name resolution failed as expected with: + test_invalid.adb:21:20: error: no matching operator found 21 | pragma Debug (X or Y, Bar); | ^^ @@ -319,6 +323,8 @@ Resolving xrefs for node Resolving xrefs for node ***************************************************************** +Name resolution failed as expected with: + test_invalid.adb:30:32: error: expected Boolean, got My_Bool 30 | Z := (for all K in 1 ..3 => X and not Y); | ^ @@ -357,6 +363,8 @@ Expr: Resolving xrefs for node ********************************************************************* +Name resolution failed as expected with: + test_task.adb:30:22: error: expected Boolean, got My_Bool 30 | entry Foo when X and not Y is | ^ diff --git a/testsuite/tests/name_resolution/use_bool_derived_type/test_invalid.adb b/testsuite/tests/name_resolution/use_bool_derived_type/test_invalid.adb index b5be6e434..6486f776f 100644 --- a/testsuite/tests/name_resolution/use_bool_derived_type/test_invalid.adb +++ b/testsuite/tests/name_resolution/use_bool_derived_type/test_invalid.adb @@ -10,7 +10,7 @@ procedure Test_Invalid is pragma Test_Block; pragma Post (Foo, X and not Y); - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); procedure Bar is null; @@ -19,7 +19,7 @@ procedure Test_Invalid is begin -- Only bool types are expected for the condition of a ``Debug`` pragma pragma Debug (X or Y, Bar); - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); -- Iterator filters seem to only accept standard booleans for K in 1 .. 3 when X and not Y loop @@ -28,5 +28,5 @@ begin pragma Test_Block; Z := (for all K in 1 ..3 => X and not Y); - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); end Test_Invalid; diff --git a/testsuite/tests/name_resolution/use_bool_derived_type/test_task.adb b/testsuite/tests/name_resolution/use_bool_derived_type/test_task.adb index fb6f6ca01..f12d8cd2c 100644 --- a/testsuite/tests/name_resolution/use_bool_derived_type/test_task.adb +++ b/testsuite/tests/name_resolution/use_bool_derived_type/test_task.adb @@ -31,7 +31,7 @@ procedure Test_Task is begin null; end Foo; - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); end P; begin null; diff --git a/testsuite/tests/name_resolution/xref_eq_aggregates_1/simple_aggregate.adb b/testsuite/tests/name_resolution/xref_eq_aggregates_1/simple_aggregate.adb index 1cae6fc73..b66490f63 100644 --- a/testsuite/tests/name_resolution/xref_eq_aggregates_1/simple_aggregate.adb +++ b/testsuite/tests/name_resolution/xref_eq_aggregates_1/simple_aggregate.adb @@ -12,7 +12,7 @@ begin pragma Test_Statement; R := (1, 2.0); - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); R := (1, Foo); pragma Test_Statement; diff --git a/testsuite/tests/name_resolution/xref_eq_aggregates_1/test.out b/testsuite/tests/name_resolution/xref_eq_aggregates_1/test.out index 9568c91be..39d318a9a 100644 --- a/testsuite/tests/name_resolution/xref_eq_aggregates_1/test.out +++ b/testsuite/tests/name_resolution/xref_eq_aggregates_1/test.out @@ -23,6 +23,8 @@ Expr: Resolving xrefs for node ********************************************************************* +Name resolution failed as expected with: + simple_aggregate.adb:14:13: error: expected Integer, got universal real 14 | R := (1, 2.0); | ^^^ diff --git a/testsuite/tests/name_resolution/xref_eq_aggregates_2/derived_aggregate.adb b/testsuite/tests/name_resolution/xref_eq_aggregates_2/derived_aggregate.adb index de4b9eb2d..34e7b11a9 100644 --- a/testsuite/tests/name_resolution/xref_eq_aggregates_2/derived_aggregate.adb +++ b/testsuite/tests/name_resolution/xref_eq_aggregates_2/derived_aggregate.adb @@ -26,5 +26,5 @@ begin pragma Test_Statement; R := (3, 4, 1.0, 2.0); - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); end Derived_Aggregate; diff --git a/testsuite/tests/name_resolution/xref_eq_aggregates_2/test.out b/testsuite/tests/name_resolution/xref_eq_aggregates_2/test.out index 4644382c9..4e9d353e6 100644 --- a/testsuite/tests/name_resolution/xref_eq_aggregates_2/test.out +++ b/testsuite/tests/name_resolution/xref_eq_aggregates_2/test.out @@ -113,6 +113,8 @@ Expr: Resolving xrefs for node ********************************************************************** +Name resolution failed as expected with: + derived_aggregate.adb:28:10: error: expected Float, got universal integer 28 | R := (3, 4, 1.0, 2.0); | ^ diff --git a/testsuite/tests/name_resolution/xref_eq_chr_literal/test.out b/testsuite/tests/name_resolution/xref_eq_chr_literal/test.out index e56ea67fc..e9e9db1cb 100644 --- a/testsuite/tests/name_resolution/xref_eq_chr_literal/test.out +++ b/testsuite/tests/name_resolution/xref_eq_chr_literal/test.out @@ -16,6 +16,8 @@ Expr: Resolving xrefs for node ************************************************************* +Name resolution failed as expected with: + testchrlit.adb:9:9: error: expected Char, got universal integer 9 | C := 12; | ^^ diff --git a/testsuite/tests/name_resolution/xref_eq_chr_literal/testchrlit.adb b/testsuite/tests/name_resolution/xref_eq_chr_literal/testchrlit.adb index 4779dfd0b..56c224ef0 100644 --- a/testsuite/tests/name_resolution/xref_eq_chr_literal/testchrlit.adb +++ b/testsuite/tests/name_resolution/xref_eq_chr_literal/testchrlit.adb @@ -7,5 +7,5 @@ begin pragma Test_Statement; C := 12; - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); end Testchrlit; diff --git a/testsuite/tests/name_resolution/xref_eq_enum_literals/enum_types.adb b/testsuite/tests/name_resolution/xref_eq_enum_literals/enum_types.adb index a6384d6a2..c0eb250d4 100644 --- a/testsuite/tests/name_resolution/xref_eq_enum_literals/enum_types.adb +++ b/testsuite/tests/name_resolution/xref_eq_enum_literals/enum_types.adb @@ -12,5 +12,5 @@ begin pragma Test_Statement; P := Enum_3; - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); end Test; diff --git a/testsuite/tests/name_resolution/xref_eq_enum_literals/test.out b/testsuite/tests/name_resolution/xref_eq_enum_literals/test.out index 75c181c92..fb4f42a17 100644 --- a/testsuite/tests/name_resolution/xref_eq_enum_literals/test.out +++ b/testsuite/tests/name_resolution/xref_eq_enum_literals/test.out @@ -28,6 +28,8 @@ Expr: Resolving xrefs for node *************************************************************** +Name resolution failed as expected with: + enum_types.adb:14:9: error: expected A, got B 14 | P := Enum_3; | ^^^^^^ diff --git a/testsuite/tests/name_resolution/xref_eq_proc_call_2/test.adb b/testsuite/tests/name_resolution/xref_eq_proc_call_2/test.adb index 47c86f8ce..843fb9102 100644 --- a/testsuite/tests/name_resolution/xref_eq_proc_call_2/test.adb +++ b/testsuite/tests/name_resolution/xref_eq_proc_call_2/test.adb @@ -12,5 +12,5 @@ begin pragma Test_Statement; C (12); - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); end Lol; diff --git a/testsuite/tests/name_resolution/xref_eq_proc_call_2/test.out b/testsuite/tests/name_resolution/xref_eq_proc_call_2/test.out index 363c5eec6..b372e3e18 100644 --- a/testsuite/tests/name_resolution/xref_eq_proc_call_2/test.out +++ b/testsuite/tests/name_resolution/xref_eq_proc_call_2/test.out @@ -40,6 +40,8 @@ Expr: Resolving xrefs for node ******************************************************* +Name resolution failed as expected with: + test.adb:14:4: error: resolution failed 14 | C (12); | ^^^^^^^ diff --git a/testsuite/tests/name_resolution/xref_eq_recursive_callexpr_2/test.adb b/testsuite/tests/name_resolution/xref_eq_recursive_callexpr_2/test.adb index f2f2645e9..b22a40ab0 100644 --- a/testsuite/tests/name_resolution/xref_eq_recursive_callexpr_2/test.adb +++ b/testsuite/tests/name_resolution/xref_eq_recursive_callexpr_2/test.adb @@ -27,5 +27,5 @@ begin pragma Test_Statement; B := Pouet (5) (8.0); - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); end Test; diff --git a/testsuite/tests/name_resolution/xref_eq_recursive_callexpr_2/test.out b/testsuite/tests/name_resolution/xref_eq_recursive_callexpr_2/test.out index c4d175a29..22f50f094 100644 --- a/testsuite/tests/name_resolution/xref_eq_recursive_callexpr_2/test.out +++ b/testsuite/tests/name_resolution/xref_eq_recursive_callexpr_2/test.out @@ -86,6 +86,8 @@ Expr: Resolving xrefs for node ********************************************************* +Name resolution failed as expected with: + test.adb:29:20: error: expected Integer, got universal real 29 | B := Pouet (5) (8.0); | ^^^ diff --git a/testsuite/tests/name_resolution/xref_eq_string_literals/test.out b/testsuite/tests/name_resolution/xref_eq_string_literals/test.out index 1aae4bb65..511de25df 100644 --- a/testsuite/tests/name_resolution/xref_eq_string_literals/test.out +++ b/testsuite/tests/name_resolution/xref_eq_string_literals/test.out @@ -16,6 +16,8 @@ Expr: Resolving xrefs for node *************************************************************** +Name resolution failed as expected with: + teststrlit.adb:16:9: error: Int does not allow string literals 16 | I := "abc"; | ^^^^^ diff --git a/testsuite/tests/name_resolution/xref_eq_string_literals/teststrlit.adb b/testsuite/tests/name_resolution/xref_eq_string_literals/teststrlit.adb index 0681474d4..e8148064d 100644 --- a/testsuite/tests/name_resolution/xref_eq_string_literals/teststrlit.adb +++ b/testsuite/tests/name_resolution/xref_eq_string_literals/teststrlit.adb @@ -14,7 +14,7 @@ begin pragma Test_Statement; I := "abc"; - pragma Test_Statement; + pragma Test_Statement (Expect_Fail => True); I := Foo ("abc"); pragma Test_Statement;