Merge pull request #2681 from hurufu/remove-dcgs-that-have-failed-to-…

…expand Remove DCGs that have thrown an exception during term expansion
mthom · Dec 25, 2024 · d57f871 · d57f871
2 parents afc7b74 + a599a11
commit d57f871
Show file tree

Hide file tree

Showing 5 changed files with 19 additions and 2 deletions.
diff --git a/src/lib/dcgs.pl b/src/lib/dcgs.pl
@@ -214,10 +214,13 @@
     dcg_body(GRIf, S0, S1, If),
     dcg_body(GRThen, S1, S, Then).
 
+
+% When DCG expansion throws an exception – remove offending term and rethrow.
+user:term_expansion(throw_dcg_expansion_error(E), _) :-
+    throw(E).
 user:term_expansion(Term0, Term) :-
     nonvar(Term0),
-    dcg_rule(Term0, Term).
-
+    catch(dcg_rule(Term0, Term), E, Term = throw_dcg_expansion_error(E)).
 
 %% seq(Seq)//
 % 

diff --git a/tests/scryer/cli/issues/not_supported_dcg_constructs.in/main.pl b/tests/scryer/cli/issues/not_supported_dcg_constructs.in/main.pl
@@ -0,0 +1,6 @@
+:- use_module(library(dcgs)).
+
+d -->
+        (   { true } -> []
+        ;   { true } -> []
+        ).
diff --git a/tests/scryer/cli/issues/not_supported_dcg_constructs.stderr b/tests/scryer/cli/issues/not_supported_dcg_constructs.stderr
diff --git a/tests/scryer/cli/issues/not_supported_dcg_constructs.stdout b/tests/scryer/cli/issues/not_supported_dcg_constructs.stdout
@@ -0,0 +1 @@
+   error(representation_error(dcg_body),[culprit-({true}->[])]).
diff --git a/tests/scryer/cli/issues/not_supported_dcg_constructs.toml b/tests/scryer/cli/issues/not_supported_dcg_constructs.toml
@@ -0,0 +1,7 @@
+# issue 2675
+args = [
+    "-f",
+    "--no-add-history",
+    "-g", "halt",
+     "main.pl"
+]
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1 @@
		error(representation_error(dcg_body),[culprit-({true}->[])]).