Merge branch 'topic/project_errors' into 'master'

Rework the project error reporting in the LKQL engine

See merge request eng/libadalang/langkit-query-language!283

lkql_jit/language/src/main/java/com/adacore/lkql_jit/LKQLContext.java

@@ -499,8 +499,8 @@ public void initSources() {
         }
 
         // Get the project file and use it if there is one
-        String projectFileName = this.getProjectFile();
-        if (projectFileName != null && !projectFileName.isEmpty() && !projectFileName.isBlank()) {
+        final String projectFileName = this.getProjectFile();
+        if (!projectFileName.isBlank()) {
             this.projectManager =
                     Libadalang.ProjectManager.create(
                             projectFileName,
@@ -511,8 +511,10 @@ public void initSources() {
 
             // Forward the project diagnostics if there are some
             if (!this.projectManager.getDiagnostics().isEmpty()) {
-                throw LKQLRuntimeException.fromMessage(
-                        "Error(s) during project opening: " + this.projectManager.getDiagnostics());
+                this.getDiagnosticEmitter()
+                        .emitProjectErrors(
+                                new File(projectFileName).getName(),
+                                this.projectManager.getDiagnostics());
             }
 
             // Get the subproject provided by the user

lkql_jit/language/src/main/java/com/adacore/lkql_jit/checker/utils/CheckerUtils.java

@@ -14,6 +14,7 @@
 import com.adacore.lkql_jit.utils.functions.StringUtils;
 import com.adacore.lkql_jit.utils.source_location.SourceLocation;
 import com.oracle.truffle.api.CompilerDirectives;
+import java.util.List;
 import org.graalvm.collections.EconomicMap;
 
 /**
@@ -150,7 +151,6 @@ default String kindtoString(MessageKind messageKind) {
 
         /** Shortcut to emit a "file not found" message. */
         default void emitFileNotFound(SourceLocation from, String fileName, boolean isError) {
-
             this.emitDiagnostic(
                     isError ? MessageKind.ERROR : MessageKind.WARNING,
                     "File "
@@ -161,6 +161,17 @@ default void emitFileNotFound(SourceLocation from, String fileName, boolean isEr
                     null);
         }
 
+        /** Method used to report an error array returned by a project loading. */
+        default void emitProjectErrors(String projectFileName, List<String> errorMessages) {
+            final LKQLContext context = LKQLLanguage.getContext(null);
+            if (!errorMessages.isEmpty()) {
+                context.println("Error(s) when opening project file: " + projectFileName);
+                for (String errorMessage : errorMessages) {
+                    context.println(" - " + errorMessage);
+                }
+            }
+        }
+
         default boolean useFullFilePath() {
             return false;
         }
@@ -294,13 +305,18 @@ public String kindtoString(MessageKind messageKind) {
 
         @Override
         public void emitFileNotFound(SourceLocation from, String fileName, boolean isError) {
-
             this.emitDiagnostic(
                     isError ? MessageKind.ERROR : MessageKind.WARNING,
                     "cannot find " + (FileUtils.baseName(fileName)),
                     from,
                     null,
                     null);
         }
+
+        @Override
+        public void emitProjectErrors(String projectFileName, List<String> errorMessages) {
+            // Do nothing on purpose, project errors has already been reported by the GNATcheck
+            // driver.
+        }
     }
 }

testsuite/ada_projects/access_decls/access_decls.ads

@@ -0,0 +1,7 @@
+package Access_Decls is
+
+   type Int_Access is access all Integer;
+
+   type Volt is delta 0.125 range 0.0 .. 255.0;
+
+end Access_Decls;

testsuite/ada_projects/aspect_decls/aspect_decls.ads

@@ -1,6 +1,6 @@
 with Interfaces, System, System.Storage_Elements;
 
-package Foo is
+package Aspect_Decls is
     Variable: Interfaces.Unsigned_8
         with Address => System.Storage_Elements.to_Address (0), Volatile;
 
@@ -13,4 +13,4 @@ package Foo is
 
     Variable4 : My_Int
         with Address => Variable3'Address;
-end Foo;
+end Aspect_Decls;

testsuite/tests/checks/KP-19038/test.adb

@@ -1,6 +1,6 @@
 with Ada.Text_IO;
 
-procedure Excl1 is
+procedure Test is
    protected type PT with Exclusive_Functions is   -- FLAG
       function Unlock return Boolean;
       procedure Unlock;
@@ -57,4 +57,4 @@ begin
       delay 2.0;
       Ada.Text_IO.Put_Line ("Entry call timed out");
    end select;
-end;
+end Test;

testsuite/tests/checks/KP-19198/main.adb

@@ -1,5 +1,5 @@
 with System;
-procedure Bad_Agg_Init_With_Address_Clause is
+procedure Main is
    pragma Assertion_Policy (Check);
 
    Buff : aliased String (1 .. 100);
@@ -59,4 +59,4 @@ begin
    exception
       when Constraint_Error => null;
    end;
-end Bad_Agg_Init_With_Address_Clause;
+end Main;

testsuite/tests/checks/KP-S114-015/test.out

@@ -1,4 +1,4 @@
-p.ads:12:9: rule violation: possible occurrence of KP S124-035
+main.ads:12:9: rule violation: possible occurrence of KP S124-035
 12 |    type Variant (Disc : User := User'First) is record  --  FLAG
    |         ^^^^^^^
 

testsuite/tests/checks/KP-U803-030/pkg3.ads

@@ -1,5 +1,5 @@
-package Pkg is
+package Pkg3 is
    function Prepend_Abc (S : String) return String is ("abc" & S);
 
    pragma Assert (Prepend_Abc ("def") = "abcdef");  --  NOFLAG
-end Pkg;
+end Pkg3;

testsuite/tests/checks/blocks/blocks.adb

@@ -2,7 +2,7 @@ package body Blocks is
 
    procedure A is
    begin
-      
+
       declare  --  FLAG
       begin
          null;

testsuite/tests/checks/blocks/checks_blocks.gpr

@@ -1,3 +1,2 @@
 project Checks_Blocks is
-    for Main use ("main.adb");
 end Checks_Blocks;

testsuite/tests/checks/deep_inheritance/definitions.ads

@@ -1,4 +1,4 @@
-package Test is 
+package Definitions is
     type I0 is interface;
     type I1 is interface and I0;
     type I2 is interface and I1;
@@ -7,4 +7,4 @@ package Test is
     type T1 is new T0 and I0 with null record;
     type T2 is new T0 and I1 with null record;
     type T3 is new T0 and I2 with null record; --  FLAG (if rule parameter is 2)
-end Test;
+end Definitions;

testsuite/tests/checks/deep_library/moderatly-deep-pkg.ads → testsuite/tests/checks/deep_library/moderately-deep-pkg.ads

@@ -1,3 +1,3 @@
 package Moderately.Deep.Pkg is
 
-end Moderately.Deep.Pkg;
+end Moderately.Deep.Pkg;

testsuite/tests/checks/deep_library/prj.gpr

@@ -1,2 +1,2 @@
 project Prj is
-end Prj;
+end Prj;

testsuite/tests/checks/raise_builtin/prj.gpr

@@ -1,2 +1,2 @@
 project Prj is
-end Prj;
+end Prj;

testsuite/tests/checks/raise_builtin/test.out

@@ -1,12 +1,12 @@
-src.adb:7:4: rule violation: explicit raise of a predefined exception
+raise_builtin.adb:7:4: rule violation: explicit raise of a predefined exception
 7 |    raise Program_Error with "Message";  --  FLAG
   |    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 
-src.adb:9:4: rule violation: explicit raise of a predefined exception
+raise_builtin.adb:9:4: rule violation: explicit raise of a predefined exception
 9 |    raise Ren;                           --  FLAG
   |    ^^^^^^^^^^
 
-src.adb:13:7: rule violation: explicit raise of a predefined exception
+raise_builtin.adb:13:7: rule violation: explicit raise of a predefined exception
 13 |       raise Ren2;                       --  FLAG
    |       ^^^^^^^^^^^
 

testsuite/tests/checks/recursive_subprograms/simple/simple.adb

@@ -1,8 +1,8 @@
-function Factorial (N : Natural) return Positive is  --  FLAG
+function Simple (N : Natural) return Positive is  --  FLAG
 begin
    if N = 0 then
       return 1;
    else
-      return N * Factorial (N - 1);
+      return N * Simple (N - 1);
    end if;
-end Factorial;
+end Simple;

testsuite/tests/checks/recursive_subprograms/simple/transitive.adb

@@ -1,4 +1,4 @@
-procedure Main is
+procedure Transitive is
    procedure Foo;  --  FLAG
    procedure Bar;  --  FLAG
    procedure Baz;  --  FLAG
@@ -19,4 +19,4 @@ procedure Main is
    end Baz;
 begin
    null;
-end Main;
+end Transitive;

testsuite/tests/checks/recursive_subprograms/test.out

@@ -71,8 +71,8 @@ expr_p.ads:5:13: rule violation: recursive subprogram
   |             ^
 
 simple.adb:1:10: rule violation: recursive subprogram
-1 | function Factorial (N : Natural) return Positive is  --  FLAG
-  |          ^^^^^^^^^
+1 | function Simple (N : Natural) return Positive is  --  FLAG
+  |          ^^^^^^
 
 transitive.adb:2:14: rule violation: recursive subprogram
 2 |    procedure Foo;  --  FLAG

testsuite/tests/checks/same_instantiations/test.out

@@ -1,8 +1,8 @@
-inst.ads:4:4: rule violation: same instantiation found at inst2.ads:4
+inst1.ads:4:4: rule violation: same instantiation found at inst2.ads:4
 4 |    package Inst_1 is new Gen (Integer, 2);  --  FLAG
   |    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 
-inst2.ads:4:4: rule violation: same instantiation found at inst.ads:4
+inst2.ads:4:4: rule violation: same instantiation found at inst1.ads:4
 4 |    package Inst_3 is new Gen (Integer, 2);  --  FLAG
   |    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 

testsuite/tests/checks/use_for_of_loops/loop3.adb

@@ -1,6 +1,6 @@
 with Ada.Text_IO; use Ada.Text_IO;
 
-procedure Main is
+procedure Loop3 is
     type Int_Array is array (Natural range <>) of Integer;
     type Int_List (Length, Other : Natural := 10) is record
         Dep_Content : Int_Array (1 .. Length);
@@ -75,4 +75,4 @@ procedure Main is
     end Cond_Component;
 begin
     null;
-end Main;
+end Loop3;

testsuite/tests/interpreter/node_pattern_data/test.out

@@ -1 +1 @@
-[<ConcreteTypeDecl ["Int_Access"] src.ads:3:5-3:43>]
+[<ConcreteTypeDecl ["Int_Access"] access_decls.ads:3:4-3:42>]

testsuite/tests/interpreter/universal_pattern_query/test.out

@@ -1 +1 @@
-[<LibraryItem aspect_decls.ads:3:1-16:9>, <AdaNodeList aspect_decls.ads:4:5-15:43>]
+[<LibraryItem aspect_decls.ads:3:1-16:18>, <AdaNodeList aspect_decls.ads:4:5-15:43>]