From d5cd1241aca919a5a51c4519497b91a722fd7e5d Mon Sep 17 00:00:00 2001 From: Hugo Guerrier Date: Thu, 29 Aug 2024 14:39:47 +0200 Subject: [PATCH] Rework the project error reporting in the LKQL engine In the same time cleanup the LKQL testsuite to avoid warnings during project loading. --- .../com/adacore/lkql_jit/LKQLContext.java | 10 ++++++---- .../lkql_jit/checker/utils/CheckerUtils.java | 20 +++++++++++++++++-- .../access_decls/access_decls.ads | 7 +++++++ testsuite/ada_projects/access_decls/src.ads | 7 ------- .../aspect_decls/aspect_decls.ads | 4 ++-- testsuite/tests/checks/KP-19038/test.adb | 4 ++-- testsuite/tests/checks/KP-19198/main.adb | 4 ++-- .../checks/KP-S114-015/{p.ads => main.ads} | 0 testsuite/tests/checks/KP-S114-015/test.out | 2 +- testsuite/tests/checks/KP-U803-030/pkg3.ads | 4 ++-- testsuite/tests/checks/blocks/blocks.adb | 2 +- .../tests/checks/blocks/checks_blocks.gpr | 1 - .../checks/deep_inheritance/definitions.ads | 4 ++-- ...y-deep-pkg.ads => moderately-deep-pkg.ads} | 2 +- testsuite/tests/checks/deep_library/prj.gpr | 2 +- testsuite/tests/checks/raise_builtin/prj.gpr | 2 +- .../{src.adb => raise_builtin.adb} | 0 testsuite/tests/checks/raise_builtin/test.out | 6 +++--- .../recursive_subprograms/simple/simple.adb | 6 +++--- .../simple/transitive.adb | 4 ++-- .../checks/recursive_subprograms/test.out | 4 ++-- .../{inst.ads => inst1.ads} | 0 .../tests/checks/same_instantiations/test.out | 4 ++-- .../tests/checks/use_for_of_loops/loop3.adb | 4 ++-- .../interpreter/node_pattern_data/test.out | 2 +- .../universal_pattern_query/test.out | 2 +- 26 files changed, 62 insertions(+), 45 deletions(-) create mode 100644 testsuite/ada_projects/access_decls/access_decls.ads delete mode 100644 testsuite/ada_projects/access_decls/src.ads rename testsuite/tests/checks/KP-S114-015/{p.ads => main.ads} (100%) rename testsuite/tests/checks/deep_library/{moderatly-deep-pkg.ads => moderately-deep-pkg.ads} (56%) rename testsuite/tests/checks/raise_builtin/{src.adb => raise_builtin.adb} (100%) rename testsuite/tests/checks/same_instantiations/{inst.ads => inst1.ads} (100%) diff --git a/lkql_jit/language/src/main/java/com/adacore/lkql_jit/LKQLContext.java b/lkql_jit/language/src/main/java/com/adacore/lkql_jit/LKQLContext.java index 4d29f30d9..535a8affd 100644 --- a/lkql_jit/language/src/main/java/com/adacore/lkql_jit/LKQLContext.java +++ b/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 diff --git a/lkql_jit/language/src/main/java/com/adacore/lkql_jit/checker/utils/CheckerUtils.java b/lkql_jit/language/src/main/java/com/adacore/lkql_jit/checker/utils/CheckerUtils.java index 341447044..4ec10b073 100644 --- a/lkql_jit/language/src/main/java/com/adacore/lkql_jit/checker/utils/CheckerUtils.java +++ b/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 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,7 +305,6 @@ 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)), @@ -302,5 +312,11 @@ public void emitFileNotFound(SourceLocation from, String fileName, boolean isErr null, null); } + + @Override + public void emitProjectErrors(String projectFileName, List errorMessages) { + // Do nothing on purpose, project errors has already been reported by the GNATcheck + // driver. + } } } diff --git a/testsuite/ada_projects/access_decls/access_decls.ads b/testsuite/ada_projects/access_decls/access_decls.ads new file mode 100644 index 000000000..2587e9718 --- /dev/null +++ b/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; diff --git a/testsuite/ada_projects/access_decls/src.ads b/testsuite/ada_projects/access_decls/src.ads deleted file mode 100644 index 8fb167208..000000000 --- a/testsuite/ada_projects/access_decls/src.ads +++ /dev/null @@ -1,7 +0,0 @@ -package Foo is - - type Int_Access is access all Integer; - - type Volt is delta 0.125 range 0.0 .. 255.0; - -end Foo; diff --git a/testsuite/ada_projects/aspect_decls/aspect_decls.ads b/testsuite/ada_projects/aspect_decls/aspect_decls.ads index 906024aaf..937247f78 100644 --- a/testsuite/ada_projects/aspect_decls/aspect_decls.ads +++ b/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; diff --git a/testsuite/tests/checks/KP-19038/test.adb b/testsuite/tests/checks/KP-19038/test.adb index 950f3daa0..bf831cac5 100644 --- a/testsuite/tests/checks/KP-19038/test.adb +++ b/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; diff --git a/testsuite/tests/checks/KP-19198/main.adb b/testsuite/tests/checks/KP-19198/main.adb index 8c2b6616b..600ec87fe 100644 --- a/testsuite/tests/checks/KP-19198/main.adb +++ b/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; diff --git a/testsuite/tests/checks/KP-S114-015/p.ads b/testsuite/tests/checks/KP-S114-015/main.ads similarity index 100% rename from testsuite/tests/checks/KP-S114-015/p.ads rename to testsuite/tests/checks/KP-S114-015/main.ads diff --git a/testsuite/tests/checks/KP-S114-015/test.out b/testsuite/tests/checks/KP-S114-015/test.out index ffc08166a..c7f9044d0 100644 --- a/testsuite/tests/checks/KP-S114-015/test.out +++ b/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 | ^^^^^^^ diff --git a/testsuite/tests/checks/KP-U803-030/pkg3.ads b/testsuite/tests/checks/KP-U803-030/pkg3.ads index 220a5a960..bcb86c9cc 100644 --- a/testsuite/tests/checks/KP-U803-030/pkg3.ads +++ b/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; diff --git a/testsuite/tests/checks/blocks/blocks.adb b/testsuite/tests/checks/blocks/blocks.adb index da4aa807d..d6c594a38 100644 --- a/testsuite/tests/checks/blocks/blocks.adb +++ b/testsuite/tests/checks/blocks/blocks.adb @@ -2,7 +2,7 @@ package body Blocks is procedure A is begin - + declare -- FLAG begin null; diff --git a/testsuite/tests/checks/blocks/checks_blocks.gpr b/testsuite/tests/checks/blocks/checks_blocks.gpr index 861960ec7..054bed7fc 100644 --- a/testsuite/tests/checks/blocks/checks_blocks.gpr +++ b/testsuite/tests/checks/blocks/checks_blocks.gpr @@ -1,3 +1,2 @@ project Checks_Blocks is - for Main use ("main.adb"); end Checks_Blocks; diff --git a/testsuite/tests/checks/deep_inheritance/definitions.ads b/testsuite/tests/checks/deep_inheritance/definitions.ads index 44007abac..44ecc4edd 100644 --- a/testsuite/tests/checks/deep_inheritance/definitions.ads +++ b/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; diff --git a/testsuite/tests/checks/deep_library/moderatly-deep-pkg.ads b/testsuite/tests/checks/deep_library/moderately-deep-pkg.ads similarity index 56% rename from testsuite/tests/checks/deep_library/moderatly-deep-pkg.ads rename to testsuite/tests/checks/deep_library/moderately-deep-pkg.ads index ad7be8b8a..20967f6c5 100644 --- a/testsuite/tests/checks/deep_library/moderatly-deep-pkg.ads +++ b/testsuite/tests/checks/deep_library/moderately-deep-pkg.ads @@ -1,3 +1,3 @@ package Moderately.Deep.Pkg is -end Moderately.Deep.Pkg; \ No newline at end of file +end Moderately.Deep.Pkg; diff --git a/testsuite/tests/checks/deep_library/prj.gpr b/testsuite/tests/checks/deep_library/prj.gpr index 733dc4fba..3abfff4af 100644 --- a/testsuite/tests/checks/deep_library/prj.gpr +++ b/testsuite/tests/checks/deep_library/prj.gpr @@ -1,2 +1,2 @@ project Prj is -end Prj; \ No newline at end of file +end Prj; diff --git a/testsuite/tests/checks/raise_builtin/prj.gpr b/testsuite/tests/checks/raise_builtin/prj.gpr index 733dc4fba..3abfff4af 100644 --- a/testsuite/tests/checks/raise_builtin/prj.gpr +++ b/testsuite/tests/checks/raise_builtin/prj.gpr @@ -1,2 +1,2 @@ project Prj is -end Prj; \ No newline at end of file +end Prj; diff --git a/testsuite/tests/checks/raise_builtin/src.adb b/testsuite/tests/checks/raise_builtin/raise_builtin.adb similarity index 100% rename from testsuite/tests/checks/raise_builtin/src.adb rename to testsuite/tests/checks/raise_builtin/raise_builtin.adb diff --git a/testsuite/tests/checks/raise_builtin/test.out b/testsuite/tests/checks/raise_builtin/test.out index 6a7343327..fd38bd6c4 100644 --- a/testsuite/tests/checks/raise_builtin/test.out +++ b/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 | ^^^^^^^^^^^ diff --git a/testsuite/tests/checks/recursive_subprograms/simple/simple.adb b/testsuite/tests/checks/recursive_subprograms/simple/simple.adb index 4e49c022c..be5c3ec60 100644 --- a/testsuite/tests/checks/recursive_subprograms/simple/simple.adb +++ b/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; diff --git a/testsuite/tests/checks/recursive_subprograms/simple/transitive.adb b/testsuite/tests/checks/recursive_subprograms/simple/transitive.adb index 2eb3aa846..8f22aa13b 100644 --- a/testsuite/tests/checks/recursive_subprograms/simple/transitive.adb +++ b/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; diff --git a/testsuite/tests/checks/recursive_subprograms/test.out b/testsuite/tests/checks/recursive_subprograms/test.out index 39e00fd07..f2155ccf9 100644 --- a/testsuite/tests/checks/recursive_subprograms/test.out +++ b/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 diff --git a/testsuite/tests/checks/same_instantiations/inst.ads b/testsuite/tests/checks/same_instantiations/inst1.ads similarity index 100% rename from testsuite/tests/checks/same_instantiations/inst.ads rename to testsuite/tests/checks/same_instantiations/inst1.ads diff --git a/testsuite/tests/checks/same_instantiations/test.out b/testsuite/tests/checks/same_instantiations/test.out index 665a1a9a6..33a54a2e7 100644 --- a/testsuite/tests/checks/same_instantiations/test.out +++ b/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 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ diff --git a/testsuite/tests/checks/use_for_of_loops/loop3.adb b/testsuite/tests/checks/use_for_of_loops/loop3.adb index ab515a039..d15b8d1e5 100644 --- a/testsuite/tests/checks/use_for_of_loops/loop3.adb +++ b/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; diff --git a/testsuite/tests/interpreter/node_pattern_data/test.out b/testsuite/tests/interpreter/node_pattern_data/test.out index 2486037b1..510d05bcd 100644 --- a/testsuite/tests/interpreter/node_pattern_data/test.out +++ b/testsuite/tests/interpreter/node_pattern_data/test.out @@ -1 +1 @@ -[] +[] diff --git a/testsuite/tests/interpreter/universal_pattern_query/test.out b/testsuite/tests/interpreter/universal_pattern_query/test.out index 9dbcb951e..2f105e91a 100644 --- a/testsuite/tests/interpreter/universal_pattern_query/test.out +++ b/testsuite/tests/interpreter/universal_pattern_query/test.out @@ -1 +1 @@ -[, ] +[, ]