mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-27 07:14:20 +00:00
Code Issues Projects Releases Wiki Activity
Files
dadf30718d6084962be37dae8b94de41aaee90e2
mercury/tests/invalid_options_file/Mmakefile
Zoltan Somogyi 1676d74e87 diff --git a/compiler/options_file.m b/compiler/options_file.m 
index f3a6ee999..e9675c97d 100644
--- a/compiler/options_file.m
+++ b/compiler/options_file.m
@@ -130,12 +130,14 @@
 :- import_module parse_tree.
 :- import_module parse_tree.error_util.

+:- import_module assoc_list.
 :- import_module bool.
 :- import_module char.
 :- import_module dir.
 :- import_module int.
 :- import_module one_or_more.
 :- import_module map.
+:- import_module pair.
 :- import_module require.
 :- import_module std_util.
 :- import_module string.
@@ -195,17 +197,15 @@ read_options_file_set_params(OptionSearchDirs, OptionsFile,
         IsOptionsFileOptional = options_file_must_exist
     ),
     SearchInfo = search_info(MaybeDirName, MaybeSearch),
-    MaybeContext = no,
-    read_options_file_params(SearchInfo, MaybeContext, IsOptionsFileOptional,
+    read_options_file_params(SearchInfo, pre_stack_base, IsOptionsFileOptional,
         OptionsFile, !Variables, !IOSpecs, !ParseSpecs, !UndefSpecs, !IO).

 %---------------------%

 read_named_options_file(OptionsPathName, !Variables, Specs, UndefSpecs, !IO) :-
     SearchInfo = search_info(no, no_search),
-    MaybeContext = no,
-    read_options_file_params(SearchInfo, MaybeContext, options_file_must_exist,
-        OptionsPathName, !Variables,
+    read_options_file_params(SearchInfo, pre_stack_base,
+        options_file_must_exist, OptionsPathName, !Variables,
         [], IOSpecs, [], ParseSpecs, [], UndefSpecs, !IO),
     Specs = IOSpecs ++ ParseSpecs.

@@ -261,25 +261,63 @@ read_args_file(OptionsFile, MaybeMCFlags, Specs, UndefSpecs, !IO) :-
     --->    options_file_need_not_exist
     ;       options_file_must_exist.

+    % The inclusion stack records, for the options file being processed,
+    % which other options files, if any, contained the include directives
+    % that lead to it being read. We use it to detect circular inclusions.
+:- type incl_stack
+    --->    incl_stack_base(
+                % The file named here is either read automatically by
+                % the compiler (e.g. Mercury.options) or its reading
+                % was requested by the user via an --options-file
+                % compiler option.
+                file_name
+            )
+    ;       incl_stack_nested(
+                % We read the file named here in response to an "include"
+                % directive.
+                file_name,
+
+                % The context of that include directive.
+                term.context,
+
+                % The "provenance" of the file that contains that include
+                % directive.
+                incl_stack
+            ).
+
+    % The pre_incl_stack is a version of the incl_stack *before* file_util.m
+    % finds the full pathname of a possibly-searched-for options file for us.
+:- type pre_incl_stack
+    --->    pre_stack_base
+    ;       pre_stack_nested(term.context, incl_stack).
+
 :- pred read_options_file_params(search_info::in,
-    maybe(term.context)::in, is_options_file_optional::in,
+    pre_incl_stack::in, is_options_file_optional::in,
     string::in, options_variables::in, options_variables::out,
     list(error_spec)::in, list(error_spec)::out,
     list(error_spec)::in, list(error_spec)::out,
     list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.

-read_options_file_params(SearchInfo, MaybeContext, IsOptionsFileOptional,
+read_options_file_params(SearchInfo, PreStack0, IsOptionsFileOptional,
         OptionsPathName, !Variables,
         !IOSpecs, !ParseSpecs, !UndefSpecs, !IO) :-
     ( if OptionsPathName = "-" then
-        % Read from standard input.
-        trace [compiletime(flag("options_file_debug")), io(!TIO)] (
-            io.write_string("Reading options file from stdin...", !TIO)
-        ),
-        SearchInfo = search_info(_MaybeDirName, Search),
-        SubSearchInfo = search_info(yes(dir.this_directory), Search),
-        read_options_lines(SubSearchInfo, io.stdin_stream, "stdin", 1,
-            !Variables, !IOSpecs, !ParseSpecs, !UndefSpecs, !IO)
+        check_include_for_infinite_recursion(PreStack0, "-", CheckResult),
+        (
+            CheckResult = include_ok(InclStack0),
+            % Read from standard input.
+            trace [compiletime(flag("options_file_debug")), io(!TIO)] (
+                io.write_string("Reading options file from stdin...", !TIO)
+            ),
+            SearchInfo = search_info(_MaybeDirName, Search),
+            SubSearchInfo = search_info(yes(dir.this_directory), Search),
+            read_options_lines(SubSearchInfo, InclStack0,
+                io.stdin_stream, "stdin", 1, !Variables,
+                !IOSpecs, !ParseSpecs, !UndefSpecs, !IO)
+        ;
+            CheckResult = include_error(CheckSpec),
+            !:ParseSpecs = [CheckSpec | !.ParseSpecs]
+        )
     else
         trace [compiletime(flag("options_file_debug")), io(!TIO)] (
             io.format("Searching for options file %s",
@@ -329,22 +367,31 @@ read_options_file_params(SearchInfo, MaybeContext, IsOptionsFileOptional,
         (
             MaybeDirAndStream =
                 ok(path_name_and_stream(FoundDir, FoundStream)),
-            trace [compiletime(flag("options_file_debug")), io(!TIO)] (
-                io.format("Reading options file %s",
-                    [s(FoundDir/FileToFind)], !TIO)
-            ),
+            check_include_for_infinite_recursion(PreStack0,
+                FoundDir / FileToFind, CheckResult),
+            (
+                CheckResult = include_ok(InclStack0),
+                trace [compiletime(flag("options_file_debug")), io(!TIO)] (
+                    io.format("Reading options file %s",
+                        [s(FoundDir/FileToFind)], !TIO)
+                ),

-            % XXX Instead of setting and unsetting the input stream,
-            % we should simply pass FoundStream to read_options_lines.
-            % However, when I (zs) tried that, I quickly found that
-            % the call tree of read_options_lines includes many predicates
-            % for which it is not at all clear whether they *intend*
-            % to read from a current standard input that originates as
-            % FoundStream, or they just *happen* to do so.
-
-            SubSearchInfo = search_info(yes(FoundDir), Search),
-            read_options_lines(SubSearchInfo, FoundStream, FileToFind, 1,
-                !Variables, !IOSpecs, !ParseSpecs, !UndefSpecs, !IO),
+                % XXX Instead of setting and unsetting the input stream,
+                % we should simply pass FoundStream to read_options_lines.
+                % However, when I (zs) tried that, I quickly found that
+                % the call tree of read_options_lines includes many predicates
+                % for which it is not at all clear whether they *intend*
+                % to read from a current standard input that originates as
+                % FoundStream, or they just *happen* to do so.
+
+                SubSearchInfo = search_info(yes(FoundDir), Search),
+                read_options_lines(SubSearchInfo, InclStack0,
+                    FoundStream, FileToFind, 1, !Variables,
+                    !IOSpecs, !ParseSpecs, !UndefSpecs, !IO)
+            ;
+                CheckResult = include_error(CheckSpec),
+                !:ParseSpecs = [CheckSpec | !.ParseSpecs]
+            ),
             io.close_input(FoundStream, !IO)
         ;
             MaybeDirAndStream = error(Error),
@@ -359,6 +406,13 @@ read_options_file_params(SearchInfo, MaybeContext, IsOptionsFileOptional,
                 else
                     ErrorFile = FileToFind
                 ),
+                (
+                    PreStack0 = pre_stack_base,
+                    MaybeContext = no
+                ;
+                    PreStack0 = pre_stack_nested(Context, _),
+                    MaybeContext = yes(Context)
+                ),
                 Spec = error_spec($pred, severity_error, phase_read_files,
                     [error_msg(MaybeContext, treat_as_first, 0,
                         [always([words("Cannot open options file"),
@@ -374,6 +428,99 @@ read_options_file_params(SearchInfo, MaybeContext, IsOptionsFileOptional,
         io.write_string("done.\n", !TIO)
     ).

+%---------------------%
+
+:- type include_check_result
+    --->    include_ok(incl_stack)
+    ;       include_error(error_spec).
+
+:- pred check_include_for_infinite_recursion(pre_incl_stack::in,
+    file_name::in, include_check_result::out) is det.
+
+check_include_for_infinite_recursion(PreStack0, PathName, Result) :-
+    (
+        PreStack0 = pre_stack_base,
+        InclStack = incl_stack_base(PathName),
+        Result = include_ok(InclStack)
+    ;
+        PreStack0 = pre_stack_nested(Context, InclStack0),
+        ( if
+            pathname_occurs_in_incl_stack(InclStack0, PathName, Context, Spec)
+        then
+            Result = include_error(Spec)
+        else
+            InclStack = incl_stack_nested(PathName, Context, InclStack0),
+            Result = include_ok(InclStack)
+        )
+    ).
+
+:- pred pathname_occurs_in_incl_stack(incl_stack::in, file_name::in,
+    term.context::in, error_spec::out) is semidet.
+
+pathname_occurs_in_incl_stack(InclStack0, PathName, Context, Spec) :-
+    (
+        InclStack0 = incl_stack_base(StackPathName0),
+        ( if PathName = StackPathName0 then
+            Pieces = [words("Error: options file"), quote(PathName),
+                words("includes itself."), nl],
+            Spec = simplest_spec($pred, severity_error, phase_read_files,
+                Context, Pieces)
+        else
+            fail
+        )
+    ;
+        InclStack0 = incl_stack_nested(StackPathName0, Context0, InclStack1),
+        ( if PathName = StackPathName0 then
+            Pieces = [words("Error: options file"), quote(PathName),
+                words("includes itself."), nl],
+            Spec = simplest_spec($pred, severity_error, phase_read_files,
+                Context, Pieces)
+        else
+            ( if
+                pathname_occurs_in_incl_stack_2(InclStack1, PathName,
+                    [StackPathName0 - Context0], TopDownIncludes)
+            then
+                TopPathName - TopContext = list.det_head(TopDownIncludes),
+                MainPieces = [words("Error: options file"), quote(TopPathName),
+                    words("indirectly includes itself through"),
+                    words("the following chain of include directives."), nl],
+                MainMsg = simplest_msg(TopContext, MainPieces),
+                InclMsgs = list.map(include_context_msg, TopDownIncludes),
+                LastMsg = include_context_msg(PathName - Context),
+                Spec = error_spec($pred, severity_error, phase_read_files,
+                    [MainMsg | InclMsgs] ++ [LastMsg])
+            else
+                fail
+            )
+        )
+    ).
+
+:- pred pathname_occurs_in_incl_stack_2(incl_stack::in, file_name::in,
+    assoc_list(file_name, term.context)::in,
+    assoc_list(file_name, term.context)::out) is semidet.
+
+pathname_occurs_in_incl_stack_2(InclStack0, PathName, !TopDownIncludes) :-
+    (
+        InclStack0 = incl_stack_base(StackPathName0),
+        PathName = StackPathName0
+    ;
+        InclStack0 = incl_stack_nested(StackPathName0, Context0, InclStack1),
+        !:TopDownIncludes = [StackPathName0 - Context0 | !.TopDownIncludes],
+        ( if PathName = StackPathName0 then
+            true
+        else
+            pathname_occurs_in_incl_stack_2(InclStack1, PathName,
+                !TopDownIncludes)
+        )
+    ).
+
+:- func include_context_msg(pair(file_name, term.context)) = error_msg.
+
+include_context_msg(FileName - Context) = Msg :-
+    Pieces = [words("The include directive for"), quote(FileName),
+        words("here."), nl],
+    Msg = simplest_msg(Context, Pieces).
+
 %---------------------------------------------------------------------------%

 :- type maybe_is_first
@@ -387,15 +534,15 @@ read_options_file_params(SearchInfo, MaybeContext, IsOptionsFileOptional,

 %---------------------------------------------------------------------------%

-:- pred read_options_lines(search_info::in,
+:- pred read_options_lines(search_info::in, incl_stack::in,
     io.text_input_stream::in, file_name::in, int::in,
     options_variables::in, options_variables::out,
     list(error_spec)::in, list(error_spec)::out,
     list(error_spec)::in, list(error_spec)::out,
     list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.

-read_options_lines(SearchInfo, InStream, FileName, LineNumber0, !Variables,
-        !IOSpecs, !ParseSpecs, !UndefSpecs, !IO) :-
+read_options_lines(SearchInfo, InclStack0, InStream, FileName, LineNumber0,
+        !Variables, !IOSpecs, !ParseSpecs, !UndefSpecs, !IO) :-
     read_options_line(InStream, FileName, LineNumber0, LineNumber1,
         LineResult, !IO),
     (
@@ -425,9 +572,10 @@ read_options_lines(SearchInfo, InStream, FileName, LineNumber0, !Variables,
                     (
                         MaybeIncludedFileNames = ok(IncludedFileNames),
                         Context = term.context(FileName, LineNumber0),
+                        PreStack1 = pre_stack_nested(Context, InclStack0),
                         list.foldl5(
                             read_options_file_params(SearchInfo,
-                                yes(Context), IsOptionsFileOptional),
+                                PreStack1, IsOptionsFileOptional),
                             IncludedFileNames, !Variables,
                             !IOSpecs, !ParseSpecs, !UndefSpecs, !IO)
                     ;
@@ -443,8 +591,9 @@ read_options_lines(SearchInfo, InStream, FileName, LineNumber0, !Variables,
             )
         ),
         LineNumber2 = LineNumber1 + 1,
-        read_options_lines(SearchInfo, InStream, FileName, LineNumber2,
-            !Variables, !IOSpecs, !ParseSpecs, !UndefSpecs, !IO)
+        read_options_lines(SearchInfo, InclStack0, InStream,
+            FileName, LineNumber2, !Variables,
+            !IOSpecs, !ParseSpecs, !UndefSpecs, !IO)
     ;
         LineResult = pr_error(Spec),
         !:IOSpecs = [Spec | !.IOSpecs]
diff --git a/tests/invalid_options_file/Mmakefile b/tests/invalid_options_file/Mmakefile
index 3642a03cc..b6965ae16 100644
--- a/tests/invalid_options_file/Mmakefile
+++ b/tests/invalid_options_file/Mmakefile
@@ -7,6 +7,8 @@ THIS_DIR = invalid_options_file
 MAYBE_J1 =

 PROGS = \
+	inf_incl_direct \
+	inf_incl_indirect \
 	no_assign \
 	no_var \
 	nonexistent_file \
diff --git a/tests/invalid_options_file/inf_incl_direct.err_exp b/tests/invalid_options_file/inf_incl_direct.err_exp
index e69de29bb..4466b9dee 100644
--- a/tests/invalid_options_file/inf_incl_direct.err_exp
+++ b/tests/invalid_options_file/inf_incl_direct.err_exp
@@ -0,0 +1,3 @@
+inf_incl_direct.options_file:002: Error: options file
+inf_incl_direct.options_file:002:   `./inf_incl_direct.options_file' includes
+inf_incl_direct.options_file:002:   itself.
diff --git a/tests/invalid_options_file/inf_incl_direct.m b/tests/invalid_options_file/inf_incl_direct.m
index e69de29bb..64ae69ad8 100644
--- a/tests/invalid_options_file/inf_incl_direct.m
+++ b/tests/invalid_options_file/inf_incl_direct.m
@@ -0,0 +1,16 @@
+%---------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%---------------------------------------------------------------------------%
+
+:- module infinite_include_direct.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+main(!IO) :-
+    io.write_string("Hello, world.\n", !IO).
diff --git a/tests/invalid_options_file/inf_incl_direct.options_file b/tests/invalid_options_file/inf_incl_direct.options_file
index e69de29bb..432f30bd1 100644
--- a/tests/invalid_options_file/inf_incl_direct.options_file
+++ b/tests/invalid_options_file/inf_incl_direct.options_file
@@ -0,0 +1,2 @@
+MCFLAGS += -V
+include inf_incl_direct.options_file
diff --git a/tests/invalid_options_file/inf_incl_indirect.err_exp b/tests/invalid_options_file/inf_incl_indirect.err_exp
index e69de29bb..88527df26 100644
--- a/tests/invalid_options_file/inf_incl_indirect.err_exp
+++ b/tests/invalid_options_file/inf_incl_indirect.err_exp
@@ -0,0 +1,23 @@
+inf_incl_indirect.options_file:002: Error: options file
+inf_incl_indirect.options_file:002:   `./inf_incl_indirect.options_file_a'
+inf_incl_indirect.options_file:002:   indirectly includes itself through the
+inf_incl_indirect.options_file:002:   following chain of include directives.
+inf_incl_indirect.options_file:002:   The include directive for
+inf_incl_indirect.options_file:002:   `./inf_incl_indirect.options_file_a'
+inf_incl_indirect.options_file:002:   here.
+inf_incl_indirect.options_file_a:002:   The include directive for
+inf_incl_indirect.options_file_a:002:   `./inf_incl_indirect.options_file_b'
+inf_incl_indirect.options_file_a:002:   here.
+inf_incl_indirect.options_file_b:002:   The include directive for
+inf_incl_indirect.options_file_b:002:   `./inf_incl_indirect.options_file'
+inf_incl_indirect.options_file_b:002:   here.
+inf_incl_indirect.options_file:003: Error: options file
+inf_incl_indirect.options_file:003:   `./inf_incl_indirect.options_file_b'
+inf_incl_indirect.options_file:003:   indirectly includes itself through the
+inf_incl_indirect.options_file:003:   following chain of include directives.
+inf_incl_indirect.options_file:003:   The include directive for
+inf_incl_indirect.options_file:003:   `./inf_incl_indirect.options_file_b'
+inf_incl_indirect.options_file:003:   here.
+inf_incl_indirect.options_file_b:002:   The include directive for
+inf_incl_indirect.options_file_b:002:   `./inf_incl_indirect.options_file'
+inf_incl_indirect.options_file_b:002:   here.
diff --git a/tests/invalid_options_file/inf_incl_indirect.m b/tests/invalid_options_file/inf_incl_indirect.m
index e69de29bb..64ae69ad8 100644
--- a/tests/invalid_options_file/inf_incl_indirect.m
+++ b/tests/invalid_options_file/inf_incl_indirect.m
@@ -0,0 +1,16 @@
+%---------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%---------------------------------------------------------------------------%
+
+:- module infinite_include_direct.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+main(!IO) :-
+    io.write_string("Hello, world.\n", !IO).
diff --git a/tests/invalid_options_file/inf_incl_indirect.options_file b/tests/invalid_options_file/inf_incl_indirect.options_file
index e69de29bb..a3a3ec858 100644
--- a/tests/invalid_options_file/inf_incl_indirect.options_file
+++ b/tests/invalid_options_file/inf_incl_indirect.options_file
@@ -0,0 +1,3 @@
+MCFLAGS += -V
+include inf_incl_indirect.options_file_a
+include inf_incl_indirect.options_file_b
diff --git a/tests/invalid_options_file/inf_incl_indirect.options_file_a b/tests/invalid_options_file/inf_incl_indirect.options_file_a
index e69de29bb..bc0583dc9 100644
--- a/tests/invalid_options_file/inf_incl_indirect.options_file_a
+++ b/tests/invalid_options_file/inf_incl_indirect.options_file_a
@@ -0,0 +1,2 @@
+MCFLAGS += -A
+include inf_incl_indirect.options_file_b
diff --git a/tests/invalid_options_file/inf_incl_indirect.options_file_b b/tests/invalid_options_file/inf_incl_indirect.options_file_b
index e69de29bb..e7b843ab1 100644
--- a/tests/invalid_options_file/inf_incl_indirect.options_file_b
+++ b/tests/invalid_options_file/inf_incl_indirect.options_file_b
@@ -0,0 +1,2 @@
+MCFLAGS += -B
+include inf_incl_indirect.options_file
2020-06-13 00:26:57 +10:00

48 lines
1.1 KiB
Makefile
Raw Blame History

#-----------------------------------------------------------------------------#
# vim: ts=8 sw=8 noexpandtab ft=make
#-----------------------------------------------------------------------------#
TESTS_DIR = ..
THIS_DIR = invalid_options_file
MAYBE_J1 =
PROGS = \
inf_incl_direct \
inf_incl_indirect \
no_assign \
no_var \
nonexistent_file \
undefined_var \
unterminated_string \
unterminated_var
TESTS = $(patsubst %,%-nodepend,$(sort $(PROGS)))
include ../Mmake.common
#-----------------------------------------------------------------------------#
%.runtest: %.err_res ;
%.err: %.m %.options_file
if $(MC) --errorcheck-only --options-file $*.options_file \
--halt-at-warn $(ALL_GRADEFLAGS) $(ALL_MCFLAGS) $* \
> $*.err 2>&1; \
then \
false; \
else \
true; \
fi
#-----------------------------------------------------------------------------#
clean_local: clean_invalid_options_file
clean_invalid_options_file:
realclean_local: realclean_invalid_options_file
realclean_invalid_options_file:
rm -f *.err *.err_res
#-----------------------------------------------------------------------------#
Reference in New Issue View Git Blame Copy Permalink