[m-rev.] for review: fix :- pragma source_file bug

[Ian MacLarty]

For review by anyone.

Estimated hours taken: 4
Branches: main

Fix a bug where a ":- pragma source_file" declaration was effectively
ignored if it appeared before the ":- module" declaration.  The problem was
that prog_io.read_first_term was not passing the source file name to the
predicates that read the subsequent terms.

compiler/options_file.m:
    Fix a typo in a comment.

compiler/prog_io.m:
    Change read_first_item to return the source file name, in case this
    has been changed by a ":- pragma source_file" declaration.

tests/invalid/Mmakefile:
tests/invalid/pragma_source_file.err_exp:
tests/invalid/pragma_source_file.m:
    Add a regression test.

Index: compiler/options_file.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options_file.m,v
retrieving revision 1.46
diff -u -r1.46 options_file.m
--- compiler/options_file.m	20 Jul 2007 01:22:02 -0000	1.46
+++ compiler/options_file.m	30 Jul 2007 07:58:26 -0000
@@ -60,7 +60,7 @@
 :- pred lookup_mmc_options(options_variables::in, maybe(list(string))::out,
     io::di, io::uo) is det.
 
-    % Same as lookup_mmc_module_options, but also adds the module-specific
+    % Same as lookup_mmc_options, but also adds the module-specific
     % (MCFLAGS-module) options.
     %
 :- pred lookup_mmc_module_options(options_variables::in, module_name::in,
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.282
diff -u -r1.282 prog_io.m
--- compiler/prog_io.m	27 May 2007 00:59:33 -0000	1.282
+++ compiler/prog_io.m	30 Jul 2007 07:58:26 -0000
@@ -663,7 +663,7 @@
             BaseName = ""
         ),
         file_name_to_module_name(BaseName, DefaultModuleName),
-        read_first_item(DefaultModuleName, FileName,
+        read_first_item(DefaultModuleName, FileName, _,
             ModuleName, RevMessages, _, _, _, !IO),
         MaybeModuleName = yes(ModuleName),
         prog_out.write_messages(list.reverse(RevMessages), !IO),
@@ -700,9 +700,9 @@
 read_all_items(DefaultModuleName, ModuleName, Messages, Items, Error, !IO) :-
     % Read all the items (the first one is handled specially).
     io.input_stream(Stream, !IO),
-    io.input_stream_name(Stream, SourceFileName, !IO),
-    read_first_item(DefaultModuleName, SourceFileName, ModuleName,
-        RevMessages0, RevItems0, MaybeSecondTerm, Error0, !IO),
+    io.input_stream_name(Stream, SourceFileName0, !IO),
+    read_first_item(DefaultModuleName, SourceFileName0, SourceFileName,
+        ModuleName, RevMessages0, RevItems0, MaybeSecondTerm, Error0, !IO),
     (
         MaybeSecondTerm = yes(SecondTerm),
         process_read_term(ModuleName, SecondTerm, MaybeSecondItem),
@@ -738,11 +738,11 @@
     % and then if it turns out to not be a `:- module' declaration
     % we reparse it in the default module scope. Blecchh.
     %
-:- pred read_first_item(module_name::in, file_name::in, module_name::out,
-    message_list::out, item_list::out, maybe(read_term)::out,
+:- pred read_first_item(module_name::in, file_name::in, file_name::out,
+    module_name::out, message_list::out, item_list::out, maybe(read_term)::out,
     module_error::out, io.state::di, io.state::uo) is det.
 
-read_first_item(DefaultModuleName, SourceFileName, ModuleName,
+read_first_item(DefaultModuleName, !SourceFileName, ModuleName,
         Messages, Items, MaybeSecondTerm, Error, !IO) :-
     globals.io_lookup_bool_option(warn_missing_module_name, WarnMissing, !IO),
     globals.io_lookup_bool_option(warn_wrong_module_name, WarnWrong, !IO),
@@ -750,16 +750,16 @@
     % Parse the first term, treating it as occurring within the scope
     % of the special "root" module (so that any `:- module' declaration
     % is taken to be a non-nested module unless explicitly qualified).
-    parser.read_term_filename(SourceFileName, MaybeFirstTerm, !IO),
+    parser.read_term_filename(!.SourceFileName, MaybeFirstTerm, !IO),
     root_module_name(RootModuleName),
     process_read_term(RootModuleName, MaybeFirstTerm, MaybeFirstItem),
     (
         % Apply and then skip `pragma source_file' decls, by calling ourselves
         % recursively with the new source file name.
         MaybeFirstItem = read_item_ok(FirstItem, _),
-        FirstItem = item_pragma(_, pragma_source_file(NewSourceFileName))
+        FirstItem = item_pragma(_, pragma_source_file(!:SourceFileName))
     ->
-        read_first_item(DefaultModuleName, NewSourceFileName,
+        read_first_item(DefaultModuleName, !SourceFileName,
             ModuleName, Messages, Items, MaybeSecondTerm, Error, !IO)
     ;
         % Check if the first term was a `:- module' decl.
@@ -777,7 +777,7 @@
             Messages = []
         ;
             StartModuleNameString = sym_name_to_string(StartModuleName),
-            WrongModuleWarning = "source file `" ++ SourceFileName ++
+            WrongModuleWarning = "source file `" ++ !.SourceFileName ++
                 "' contains module named `" ++ StartModuleNameString ++ "'",
             maybe_add_warning(WarnWrong, MaybeFirstTerm, FirstContext,
             WrongModuleWarning, [], Messages),
@@ -798,7 +798,7 @@
         ( MaybeFirstItem = read_item_ok(_FirstItem, FirstContext0) ->
             FirstContext = FirstContext0
         ;
-            term.context_init(SourceFileName, 1, FirstContext)
+            term.context_init(!.SourceFileName, 1, FirstContext)
         ),
         (
             WarnMissing = yes,
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.218
diff -u -r1.218 Mmakefile
--- tests/invalid/Mmakefile	25 Jul 2007 06:12:31 -0000	1.218
+++ tests/invalid/Mmakefile	30 Jul 2007 03:34:47 -0000
@@ -152,6 +152,7 @@
 	polymorphic_unification \
 	pragma_c_code_dup_var \
 	pragma_c_code_no_det \
+	pragma_source_file \
 	predmode \
 	prog_io_erroneous \
 	promise_equivalent_clauses \
Index: tests/invalid/pragma_source_file.err_exp
===================================================================
RCS file: tests/invalid/pragma_source_file.err_exp
diff -N tests/invalid/pragma_source_file.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/pragma_source_file.err_exp	30 Jul 2007 07:55:34 -0000
@@ -0,0 +1 @@
+x.m:008: Error: unrecognized declaration: an_error.
Index: tests/invalid/pragma_source_file.m
===================================================================
RCS file: tests/invalid/pragma_source_file.m
diff -N tests/invalid/pragma_source_file.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/pragma_source_file.m	31 Jul 2007 00:35:28 -0000
@@ -0,0 +1,8 @@
+:- pragma source_file("x.m").
+:- module pragma_source_file.
+
+:- interface.
+
+:- type x ---> x.
+
+:- an_error.
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------