Merge branch 'topic/1163' into 'master'

nameres: return error code when unexpected name resolution failures occur

Closes #1163

See merge request eng/libadalang/libadalang!1700

testsuite/ada/nameres.adb

@@ -155,6 +155,11 @@ procedure Nameres is
          Help => "Only output failures on stdout. Note that this triggers"
                  & " failures logging even when --quiet is passed.");
 
+      package No_Abort_On_Failures is new Parse_Flag
+        (App.Args.Parser, Long => "--no-abort-on-failures",
+         Help => "Expected name resolution failures: do not call Abort_App"
+                 & " if some name resolution failed");
+
       package Imprecise_Fallback is new Parse_Flag
         (App.Args.Parser, Long => "--imprecise-fallback",
          Help => "Activate fallback mechanism for name resolution");
@@ -1447,7 +1452,8 @@ procedure Nameres is
    is
       pragma Unreferenced (Context);
 
-      Watermark : GNATCOLL.Memory.Watermark_Info;
+      Watermark  : GNATCOLL.Memory.Watermark_Info;
+      App_Failed : Boolean := False;
    begin
       --  Measure time and memory before post-processing
 
@@ -1469,8 +1475,18 @@ procedure Nameres is
          end;
       end if;
 
+      for Job of Jobs loop
+         for File_Stats of Job_Data (Job.ID).Stats.File_Stats loop
+            App_Failed := App_Failed or File_Stats.Nb_Fails > 0;
+         end loop;
+      end loop;
+
       Free (Job_Data);
 
+      if App_Failed and then not Args.No_Abort_On_Failures.Get then
+         Abort_App ("Name resolution failed.");
+      end if;
+
       Put_Line ("Done.");
    end App_Post_Process;
 

testsuite/drivers/name_resolution_driver.py

@@ -55,6 +55,9 @@ class NameResolutionDriver(BaseDriver):
 
     * ``runtime_name``: Name of the runtime to use when loading the project
       (``--RTS`` nameres switch).
+
+    * ``expect_fail``: Do not abort the nameres application if failures are
+       expected during resolution.
     """
 
     perf_supported = True
@@ -128,7 +131,7 @@ def run(self):
         # just on nameres-specific pragmas) and display only error messages,
         # not traceback (for test output stability).
         if self.test_env.get("batch"):
-            args += ["--all", "--no-traceback"]
+            args += ["--all", "--no-traceback", "--no-abort-on-failures"]
 
             # In perf mode, we need nameres not to print anything
             if not self.perf_mode:
@@ -147,6 +150,9 @@ def run(self):
         if runtime_name:
             args.append(f"--RTS={runtime_name}")
 
+        if self.test_env.get("expect_fail"):
+            args.append("--no-abort-on-failures")
+
         # Add optional explicit list of sources to process
         args += input_sources
 

testsuite/tests/misc/auto_provider/foo.adb

@@ -6,5 +6,5 @@ procedure Foo is
    pragma Test_Statement;
 begin
    Bar;
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 end Foo;

testsuite/tests/misc/auto_provider/test.out

@@ -41,6 +41,8 @@ Expr: <Int foo.adb:5:44-5:45>
 Resolving xrefs for node <CallStmt foo.adb:8:4-8:8>
 ***************************************************
 
+Name resolution failed as expected with:
+
 foo.adb:8:4: error: no such entity
 8 |    Bar;
   |    ^^^

testsuite/tests/name_resolution/case_stmt_alt_fail/test.yaml

@@ -1,2 +1,3 @@
 driver: name-resolution
 input_sources: [test.adb]
+expect_fail: true

testsuite/tests/name_resolution/if_stmt_alt_fail/test.yaml

@@ -1,2 +1,3 @@
 driver: name-resolution
 input_sources: [test.adb]
+expect_fail: true

testsuite/tests/name_resolution/late_use_clause/test.yaml

@@ -1,2 +1,3 @@
 driver: name-resolution
 input_sources: [testuse.adb]
+expect_fail: true

testsuite/tests/name_resolution/test_expect_fail/test.yaml

@@ -1,2 +1,3 @@
 driver: name-resolution
 input_sources: [test.adb]
+expect_fail: true

testsuite/tests/name_resolution/use_bool_derived_type/test.yaml

@@ -1,2 +1,3 @@
 driver: name-resolution
 input_sources: [test_valid.adb, test_invalid.adb, test_task.adb]
+expect_fail: true

testsuite/tests/semantic_errors/anonymous_types/test.adb

@@ -6,11 +6,11 @@ procedure Test is
    Z : access T'Class;
 begin
    X := 2;
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 
    Y := 3;
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 
    Z := 4;
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 end Test;

testsuite/tests/semantic_errors/anonymous_types/test.out

@@ -4,6 +4,8 @@ Analyzing test.adb
 Resolving xrefs for node <AssignStmt test.adb:8:4-8:11>
 *******************************************************
 
+Name resolution failed as expected with:
+
 test.adb:8:9: error: expected anonymous access on Integer, got universal integer
 8 |    X := 2;
   |         ^
@@ -12,6 +14,8 @@ test.adb:8:9: error: expected anonymous access on Integer, got universal integer
 Resolving xrefs for node <AssignStmt test.adb:11:4-11:11>
 *********************************************************
 
+Name resolution failed as expected with:
+
 test.adb:11:9: error: expected anonymous array type defined at test.adb:5:8, got universal integer
 11 |    Y := 3;
    |         ^
@@ -20,6 +24,8 @@ test.adb:11:9: error: expected anonymous array type defined at test.adb:5:8, got
 Resolving xrefs for node <AssignStmt test.adb:14:4-14:11>
 *********************************************************
 
+Name resolution failed as expected with:
+
 test.adb:14:9: error: expected anonymous access on T'Class, got universal integer
 14 |    Z := 4;
    |         ^

testsuite/tests/semantic_errors/call_function_as_procedure/test.adb

@@ -2,5 +2,5 @@ procedure Test is
    function Foo (X : Integer) return Integer is (X);
 begin
    Foo (2);
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 end Test;

testsuite/tests/semantic_errors/call_function_as_procedure/test.out

@@ -4,6 +4,8 @@ Analyzing test.adb
 Resolving xrefs for node <CallStmt test.adb:4:4-4:12>
 *****************************************************
 
+Name resolution failed as expected with:
+
 test.adb:4:4: error: resolution failed
 4 |    Foo (2);
   |    ^^^^^^^^

testsuite/tests/semantic_errors/case_expr_selector/test.adb

@@ -6,5 +6,5 @@ begin
    R := (case Foo (3) is
       when True => 1,
       when False => 2);
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 end Test;

testsuite/tests/semantic_errors/complex_binop/test.adb

@@ -4,5 +4,5 @@ procedure Test is
    X : Boolean;
 begin
    X := Foo (2 + 2, True);
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 end Test;

testsuite/tests/semantic_errors/complex_binop/test.out

@@ -4,6 +4,8 @@ Analyzing test.adb
 Resolving xrefs for node <AssignStmt test.adb:6:4-6:27>
 *******************************************************
 
+Name resolution failed as expected with:
+
 test.adb:6:9: error: expected Boolean, got Integer
 6 |    X := Foo (2 + 2, True);
   |         ^^^^^^^^^^^^^^^^^
@@ -16,6 +18,8 @@ Analyzing test_2.adb
 Resolving xrefs for node <AssignStmt test_2.adb:6:4-6:31>
 *********************************************************
 
+Name resolution failed as expected with:
+
 test_2.adb:6:25: error: expected Integer, got Boolean
 6 |    X := Foo (2 + 2, 2 + True);
   |                         ^^^^
@@ -28,6 +32,8 @@ Analyzing test_3.adb
 Resolving xrefs for node <AssignStmt test_3.adb:7:4-7:27>
 *********************************************************
 
+Name resolution failed as expected with:
+
 test_3.adb:7:9: error: no matching alternative (of 2 candidates)
 7 |    X := Foo (2 + 2, True);
   |         ^^^

testsuite/tests/semantic_errors/complex_binop/test_2.adb

@@ -4,5 +4,5 @@ procedure Test is
    X : Integer;
 begin
    X := Foo (2 + 2, 2 + True);
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 end Test;

testsuite/tests/semantic_errors/complex_binop/test_3.adb

@@ -5,6 +5,6 @@ procedure Test is
    X : Boolean;
 begin
    X := Foo (2 + 2, True);
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 end Test;
 

testsuite/tests/semantic_errors/constraining_field_reference/test.adb

@@ -10,7 +10,7 @@ procedure Test is
    function Foo (X : Boolean) return Rec2 is (Y => 2);
 
    V : Integer := Foo (3).Y;
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 begin
    null;
 end Test;

testsuite/tests/semantic_errors/constraining_field_reference/test.out

@@ -4,6 +4,8 @@ Analyzing test.adb
 Resolving xrefs for node <ObjectDecl ["V"] test.adb:12:4-12:29>
 ***************************************************************
 
+Name resolution failed as expected with:
+
 test.adb:12:24: error: expected Boolean, got universal integer
 12 |    V : Integer := Foo (3).Y;
    |                        ^

testsuite/tests/semantic_errors/incompatible_access_type/test.adb

@@ -3,7 +3,7 @@ procedure Test is
 
    X : aliased Boolean := True;
    Y : Integer_Access := X'Access;
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 begin
    null;
 end Test;

testsuite/tests/semantic_errors/incompatible_access_type/test.out

@@ -4,6 +4,8 @@ Analyzing test.adb
 Resolving xrefs for node <ObjectDecl ["Y"] test.adb:5:4-5:35>
 *************************************************************
 
+Name resolution failed as expected with:
+
 test.adb:5:26: error: expected Integer, got Boolean
 5 |    Y : Integer_Access := X'Access;
   |                          ^

testsuite/tests/semantic_errors/incompatible_generic_types/test.adb

@@ -11,5 +11,5 @@ procedure Test is
    X_2 : Pkg_2.T;
 begin
    X_1 := X_2;
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 end Test;

testsuite/tests/semantic_errors/incompatible_generic_types/test.out

@@ -4,6 +4,8 @@ Analyzing test.adb
 Resolving xrefs for node <AssignStmt test.adb:13:4-13:15>
 *********************************************************
 
+Name resolution failed as expected with:
+
 test.adb:13:11: error: expected T [instance at line 7], got T [instance at line 8]
 13 |    X_1 := X_2;
    |           ^^^

testsuite/tests/semantic_errors/invalid_argument/test.adb

@@ -2,5 +2,5 @@ procedure Test is
    procedure Foo (X : Integer) is null;
 begin
    Foo (True);
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 end Test;

testsuite/tests/semantic_errors/invalid_argument/test.out

@@ -4,6 +4,8 @@ Analyzing test.adb
 Resolving xrefs for node <CallStmt test.adb:4:4-4:15>
 *****************************************************
 
+Name resolution failed as expected with:
+
 test.adb:4:9: error: expected Integer, got Boolean
 4 |    Foo (True);
   |         ^^^^

testsuite/tests/semantic_errors/invalid_array_aggregates/test.adb

@@ -2,10 +2,10 @@ procedure Test is
    type Arr is array (Positive range <>) of Integer;
 
    A : Arr := (1 .. 10 => True);
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 
    B : Arr := (True .. False => 2);
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 begin
    null;
 end Test;

testsuite/tests/semantic_errors/invalid_array_aggregates/test.out

@@ -4,6 +4,8 @@ Analyzing test.adb
 Resolving xrefs for node <ObjectDecl ["A"] test.adb:4:4-4:33>
 *************************************************************
 
+Name resolution failed as expected with:
+
 test.adb:4:27: error: expected Integer, got Boolean
 4 |    A : Arr := (1 .. 10 => True);
   |                           ^^^^
@@ -12,6 +14,8 @@ test.adb:4:27: error: expected Integer, got Boolean
 Resolving xrefs for node <ObjectDecl ["B"] test.adb:7:4-7:36>
 *************************************************************
 
+Name resolution failed as expected with:
+
 test.adb:7:16: error: expected Positive, got Boolean
 7 |    B : Arr := (True .. False => 2);
   |                ^^^^

testsuite/tests/semantic_errors/invalid_array_concat/test.adb

@@ -1,7 +1,7 @@
 procedure Test is
    X : Integer := 2;
    V : String := "ab" & X;
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 begin
    null;
 end Test;

testsuite/tests/semantic_errors/invalid_array_concat/test.out

@@ -4,6 +4,8 @@ Analyzing test.adb
 Resolving xrefs for node <ObjectDecl ["V"] test.adb:3:4-3:27>
 *************************************************************
 
+Name resolution failed as expected with:
+
 test.adb:3:23: error: no matching operator found
 3 |    V : String := "ab" & X;
   |                       ^

testsuite/tests/semantic_errors/invalid_array_indexing/test.adb

@@ -5,11 +5,11 @@ procedure Test is
    B : Boolean := True;
 begin
    A (2) := B;
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 
    B := A (2);
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 
    A (B) := 2;
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 end Test;

testsuite/tests/semantic_errors/invalid_array_indexing/test.out

@@ -4,6 +4,8 @@ Analyzing test.adb
 Resolving xrefs for node <AssignStmt test.adb:7:4-7:15>
 *******************************************************
 
+Name resolution failed as expected with:
+
 test.adb:7:13: error: expected Integer, got Boolean
 7 |    A (2) := B;
   |             ^
@@ -12,6 +14,8 @@ test.adb:7:13: error: expected Integer, got Boolean
 Resolving xrefs for node <AssignStmt test.adb:10:4-10:15>
 *********************************************************
 
+Name resolution failed as expected with:
+
 test.adb:10:9: error: expected Boolean, got Integer
 10 |    B := A (2);
    |         ^^^^^
@@ -20,6 +24,8 @@ test.adb:10:9: error: expected Boolean, got Integer
 Resolving xrefs for node <AssignStmt test.adb:13:4-13:15>
 *********************************************************
 
+Name resolution failed as expected with:
+
 test.adb:13:7: error: expected Positive, got Boolean
 13 |    A (B) := 2;
    |       ^

testsuite/tests/semantic_errors/invalid_assignment/test.adb

@@ -1,7 +1,7 @@
 procedure Test is
    V : Integer := True;
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 begin
    V := 2.3;
-   pragma Test_Statement;
+   pragma Test_Statement (Expect_Fail => True);
 end Test;