Commit 31198773 by Francois-Xavier Coudert Committed by François-Xavier Coudert

gfortran.h (gfc_add_intrinsic_modules_path, [...]): New prototypes.

	* gfortran.h (gfc_add_intrinsic_modules_path,
	gfc_open_intrinsic_module): New prototypes.
	(gfc_add_include_path, gfc_open_included_file): Update prototypes.
	* lang.opt: Add -fintrinsic-modules-path option.
	* module.c (gfc_match_use): Match the Fortran 2003 form of
	USE statement.
	(gfc_use_module): Also handle intrinsic modules. 
	* scanner.c (gfc_directorylist): Add use_for_modules for field.
	(intrinsic_modules_dirs): New static variable.
	(add_path_to_list, gfc_add_intrinsic_modules_path): New functions.
	(gfc_add_include_path): Use the new add_path_to_list helper
	function.
	(gfc_release_include_path): Free memory for intrinsic_modules_dirs.
	(open_included_file, gfc_open_intrinsic_module): New functions.
	(gfc_open_included_file): Use the new open_included_file
	helper function.
	* lang-specs.h: Use the new -fintrinsic-modules-path option.
	* parse.c (decode_statement): Do not match the required space
	after USE here.
	* options.c (gfc_handle_option): Handle the new option. Use new
	prototype for gfc_add_include_path.
	(gfc_post_options): Use new prototype for gfc_add_include_path.

	* gfortran.dg/use_1.f90: New test.
	* gfortran.dg/use_1.f90: New test.
	* gfortran.dg/use_1.f90: New test.

From-SVN: r118930
parent 9bd6112c
2006-11-17 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* gfortran.h (gfc_add_intrinsic_modules_path,
gfc_open_intrinsic_module): New prototypes.
(gfc_add_include_path, gfc_open_included_file): Update prototypes.
* lang.opt: Add -fintrinsic-modules-path option.
* module.c (gfc_match_use): Match the Fortran 2003 form of
USE statement.
(gfc_use_module): Also handle intrinsic modules.
* scanner.c (gfc_directorylist): Add use_for_modules for field.
(intrinsic_modules_dirs): New static variable.
(add_path_to_list, gfc_add_intrinsic_modules_path): New functions.
(gfc_add_include_path): Use the new add_path_to_list helper
function.
(gfc_release_include_path): Free memory for intrinsic_modules_dirs.
(open_included_file, gfc_open_intrinsic_module): New functions.
(gfc_open_included_file): Use the new open_included_file
helper function.
* lang-specs.h: Use the new -fintrinsic-modules-path option.
* parse.c (decode_statement): Do not match the required space
after USE here.
* options.c (gfc_handle_option): Handle the new option. Use new
prototype for gfc_add_include_path.
(gfc_post_options): Use new prototype for gfc_add_include_path.
2006-11-16 Francois-Xavier Coudert <coudert@clipper.ens.fr> 2006-11-16 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR fortran/29391 PR fortran/29391
......
...@@ -1709,9 +1709,11 @@ void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *); ...@@ -1709,9 +1709,11 @@ void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *);
void gfc_scanner_done_1 (void); void gfc_scanner_done_1 (void);
void gfc_scanner_init_1 (void); void gfc_scanner_init_1 (void);
void gfc_add_include_path (const char *); void gfc_add_include_path (const char *, bool);
void gfc_add_intrinsic_modules_path (const char *);
void gfc_release_include_path (void); void gfc_release_include_path (void);
FILE *gfc_open_included_file (const char *, bool); FILE *gfc_open_included_file (const char *, bool, bool);
FILE *gfc_open_intrinsic_module (const char *);
int gfc_at_end (void); int gfc_at_end (void);
int gfc_at_eof (void); int gfc_at_eof (void);
......
...@@ -15,7 +15,7 @@ This file is licensed under the GPL. */ ...@@ -15,7 +15,7 @@ This file is licensed under the GPL. */
%{E|M|MM:%(cpp_debug_options)}\ %{E|M|MM:%(cpp_debug_options)}\
%{!M:%{!MM:%{!E: -o %|.f |\n\ %{!M:%{!MM:%{!E: -o %|.f |\n\
f951 %|.f %{!ffree-form:-ffixed-form} %(cc1_options) %{J*} %{I*}\ f951 %|.f %{!ffree-form:-ffixed-form} %(cc1_options) %{J*} %{I*}\
-fpreprocessed %{!nostdinc:-I finclude%s} %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0}, -fpreprocessed %{!nostdinc:-fintrinsic-modules-path finclude%s} %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0},
{".F90", "@f95-cpp-input", 0, 0, 0}, {".F90", "@f95-cpp-input", 0, 0, 0},
{".F95", "@f95-cpp-input", 0, 0, 0}, {".F95", "@f95-cpp-input", 0, 0, 0},
{"@f95-cpp-input", {"@f95-cpp-input",
...@@ -23,13 +23,13 @@ This file is licensed under the GPL. */ ...@@ -23,13 +23,13 @@ This file is licensed under the GPL. */
%{E|M|MM:%(cpp_debug_options)}\ %{E|M|MM:%(cpp_debug_options)}\
%{!M:%{!MM:%{!E: -o %|.f95 |\n\ %{!M:%{!MM:%{!E: -o %|.f95 |\n\
f951 %|.f95 %{!ffixed-form:-ffree-form} %(cc1_options) %{J*} %{I*}\ f951 %|.f95 %{!ffixed-form:-ffree-form} %(cc1_options) %{J*} %{I*}\
-fpreprocessed %{!nostdinc:-I finclude%s} %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0}, -fpreprocessed %{!nostdinc:-fintrinsic-modules-path finclude%s} %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0},
{".f90", "@f95", 0, 0, 0}, {".f90", "@f95", 0, 0, 0},
{".f95", "@f95", 0, 0, 0}, {".f95", "@f95", 0, 0, 0},
{"@f95", "%{!E:f951 %i %(cc1_options) %{J*} %{I*}\ {"@f95", "%{!E:f951 %i %(cc1_options) %{J*} %{I*}\
%{!nostdinc:-I finclude%s} %{!fsyntax-only:%(invoke_as)}}", 0, 0, 0}, %{!nostdinc:-fintrinsic-modules-path finclude%s} %{!fsyntax-only:%(invoke_as)}}", 0, 0, 0},
{".f", "@f77", 0, 0, 0}, {".f", "@f77", 0, 0, 0},
{".for", "@f77", 0, 0, 0}, {".for", "@f77", 0, 0, 0},
{".FOR", "@f77", 0, 0, 0}, {".FOR", "@f77", 0, 0, 0},
{"@f77", "%{!E:f951 %i %{!ffree-form:-ffixed-form} %(cc1_options) %{J*} %{I*}\ {"@f77", "%{!E:f951 %i %{!ffree-form:-ffixed-form} %(cc1_options) %{J*} %{I*}\
%{!nostdinc:-I finclude%s} %{!fsyntax-only:%(invoke_as)}}", 0, 0, 0}, %{!nostdinc:-fintrinsic-modules-path finclude%s} %{!fsyntax-only:%(invoke_as)}}", 0, 0, 0},
...@@ -149,6 +149,10 @@ ffixed-form ...@@ -149,6 +149,10 @@ ffixed-form
Fortran RejectNegative Fortran RejectNegative
Assume that the source file is fixed form Assume that the source file is fixed form
fintrinsic-modules-path
Fortran RejectNegative Joined Separate
Specify where to find the compiled intrinsic modules
ffixed-line-length-none ffixed-line-length-none
Fortran RejectNegative Fortran RejectNegative
Allow arbitrary character line width in fixed mode Allow arbitrary character line width in fixed mode
......
...@@ -173,6 +173,9 @@ static FILE *module_fp; ...@@ -173,6 +173,9 @@ static FILE *module_fp;
/* The name of the module we're reading (USE'ing) or writing. */ /* The name of the module we're reading (USE'ing) or writing. */
static char module_name[GFC_MAX_SYMBOL_LEN + 1]; static char module_name[GFC_MAX_SYMBOL_LEN + 1];
/* The way the module we're reading was specified. */
static bool specified_nonint, specified_int;
static int module_line, module_column, only_flag; static int module_line, module_column, only_flag;
static enum static enum
{ IO_INPUT, IO_OUTPUT } { IO_INPUT, IO_OUTPUT }
...@@ -483,12 +486,65 @@ free_rename (void) ...@@ -483,12 +486,65 @@ free_rename (void)
match match
gfc_match_use (void) gfc_match_use (void)
{ {
char name[GFC_MAX_SYMBOL_LEN + 1]; char name[GFC_MAX_SYMBOL_LEN + 1], module_nature[GFC_MAX_SYMBOL_LEN + 1];
gfc_use_rename *tail = NULL, *new; gfc_use_rename *tail = NULL, *new;
interface_type type; interface_type type;
gfc_intrinsic_op operator; gfc_intrinsic_op operator;
match m; match m;
specified_int = false;
specified_nonint = false;
if (gfc_match (" , ") == MATCH_YES)
{
if ((m = gfc_match (" %n ::", module_nature)) == MATCH_YES)
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: module "
"nature in USE statement at %C") == FAILURE)
return MATCH_ERROR;
if (strcmp (module_nature, "intrinsic") == 0)
specified_int = true;
else
{
if (strcmp (module_nature, "non_intrinsic") == 0)
specified_nonint = true;
else
{
gfc_error ("Module nature in USE statement at %C shall "
"be either INTRINSIC or NON_INTRINSIC");
return MATCH_ERROR;
}
}
}
else
{
/* Help output a better error message than "Unclassifiable
statement". */
gfc_match (" %n", module_nature);
if (strcmp (module_nature, "intrinsic") == 0
|| strcmp (module_nature, "non_intrinsic") == 0)
gfc_error ("\"::\" was expected after module nature at %C "
"but was not found");
return m;
}
}
else
{
m = gfc_match (" ::");
if (m == MATCH_YES &&
gfc_notify_std (GFC_STD_F2003, "Fortran 2003: "
"\"USE :: module\" at %C") == FAILURE)
return MATCH_ERROR;
if (m != MATCH_YES)
{
m = gfc_match ("% ");
if (m != MATCH_YES)
return m;
}
}
m = gfc_match_name (module_name); m = gfc_match_name (module_name);
if (m != MATCH_YES) if (m != MATCH_YES)
return m; return m;
...@@ -3801,7 +3857,33 @@ gfc_use_module (void) ...@@ -3801,7 +3857,33 @@ gfc_use_module (void)
strcpy (filename, module_name); strcpy (filename, module_name);
strcat (filename, MODULE_EXTENSION); strcat (filename, MODULE_EXTENSION);
module_fp = gfc_open_included_file (filename, true); /* First, try to find an non-intrinsic module, unless the USE statement
specified that the module is intrinsic. */
module_fp = NULL;
if (!specified_int)
module_fp = gfc_open_included_file (filename, true, true);
/* Then, see if it's an intrinsic one, unless the USE statement
specified that the module is non-intrinsic. */
if (module_fp == NULL && !specified_nonint)
{
#if 0
if (strcmp (module_name, "iso_fortran_env") == 0
&& gfc_notify_std (GFC_STD_F2003, "Fortran 2003: "
"ISO_FORTRAN_ENV intrinsic module at %C") != FAILURE)
{
use_iso_fortran_env_module ();
return;
}
#endif
module_fp = gfc_open_intrinsic_module (filename);
if (module_fp == NULL && specified_int)
gfc_fatal_error ("Can't find an intrinsic module named '%s' at %C",
module_name);
}
if (module_fp == NULL) if (module_fp == NULL)
gfc_fatal_error ("Can't open module file '%s' for reading at %C: %s", gfc_fatal_error ("Can't open module file '%s' for reading at %C: %s",
filename, strerror (errno)); filename, strerror (errno));
......
...@@ -217,10 +217,10 @@ gfc_post_options (const char **pfilename) ...@@ -217,10 +217,10 @@ gfc_post_options (const char **pfilename)
source_path = alloca (i + 1); source_path = alloca (i + 1);
memcpy (source_path, canon_source_file, i); memcpy (source_path, canon_source_file, i);
source_path[i] = 0; source_path[i] = 0;
gfc_add_include_path (source_path); gfc_add_include_path (source_path, true);
} }
else else
gfc_add_include_path ("."); gfc_add_include_path (".", true);
if (canon_source_file != gfc_source_file) if (canon_source_file != gfc_source_file)
gfc_free ((void *) canon_source_file); gfc_free ((void *) canon_source_file);
...@@ -511,6 +511,11 @@ gfc_handle_option (size_t scode, const char *arg, int value) ...@@ -511,6 +511,11 @@ gfc_handle_option (size_t scode, const char *arg, int value)
gfc_option.flag_implicit_none = value; gfc_option.flag_implicit_none = value;
break; break;
case OPT_fintrinsic_modules_path:
gfc_add_include_path (arg, false);
gfc_add_intrinsic_modules_path (arg);
break;
case OPT_fmax_errors_: case OPT_fmax_errors_:
gfc_option.max_errors = value; gfc_option.max_errors = value;
break; break;
...@@ -555,7 +560,7 @@ gfc_handle_option (size_t scode, const char *arg, int value) ...@@ -555,7 +560,7 @@ gfc_handle_option (size_t scode, const char *arg, int value)
break; break;
case OPT_I: case OPT_I:
gfc_add_include_path (arg); gfc_add_include_path (arg, true);
break; break;
case OPT_J: case OPT_J:
......
...@@ -280,7 +280,7 @@ decode_statement (void) ...@@ -280,7 +280,7 @@ decode_statement (void)
break; break;
case 'u': case 'u':
match ("use% ", gfc_match_use, ST_USE); match ("use", gfc_match_use, ST_USE);
break; break;
case 'v': case 'v':
......
...@@ -51,12 +51,13 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA ...@@ -51,12 +51,13 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
typedef struct gfc_directorylist typedef struct gfc_directorylist
{ {
char *path; char *path;
bool use_for_modules;
struct gfc_directorylist *next; struct gfc_directorylist *next;
} }
gfc_directorylist; gfc_directorylist;
/* List of include file search directories. */ /* List of include file search directories. */
static gfc_directorylist *include_dirs; static gfc_directorylist *include_dirs, *intrinsic_modules_dirs;
static gfc_file *file_head, *current_file; static gfc_file *file_head, *current_file;
...@@ -118,22 +119,21 @@ gfc_scanner_done_1 (void) ...@@ -118,22 +119,21 @@ gfc_scanner_done_1 (void)
/* Adds path to the list pointed to by list. */ /* Adds path to the list pointed to by list. */
void static void
gfc_add_include_path (const char *path) add_path_to_list (gfc_directorylist **list, const char *path,
bool use_for_modules)
{ {
gfc_directorylist *dir; gfc_directorylist *dir;
const char *p; const char *p;
p = path; p = path;
while (*p == ' ' || *p == '\t') /* someone might do 'gfortran "-I include"' */ while (*p == ' ' || *p == '\t') /* someone might do "-I include" */
if (*p++ == '\0') if (*p++ == '\0')
return; return;
dir = include_dirs; dir = *list;
if (!dir) if (!dir)
{ dir = *list = gfc_getmem (sizeof (gfc_directorylist));
dir = include_dirs = gfc_getmem (sizeof (gfc_directorylist));
}
else else
{ {
while (dir->next) while (dir->next)
...@@ -144,12 +144,27 @@ gfc_add_include_path (const char *path) ...@@ -144,12 +144,27 @@ gfc_add_include_path (const char *path)
} }
dir->next = NULL; dir->next = NULL;
dir->use_for_modules = use_for_modules;
dir->path = gfc_getmem (strlen (p) + 2); dir->path = gfc_getmem (strlen (p) + 2);
strcpy (dir->path, p); strcpy (dir->path, p);
strcat (dir->path, "/"); /* make '/' last character */ strcat (dir->path, "/"); /* make '/' last character */
} }
void
gfc_add_include_path (const char *path, bool use_for_modules)
{
add_path_to_list (&include_dirs, path, use_for_modules);
}
void
gfc_add_intrinsic_modules_path (const char *path)
{
add_path_to_list (&intrinsic_modules_dirs, path, true);
}
/* Release resources allocated for options. */ /* Release resources allocated for options. */
void void
...@@ -165,28 +180,30 @@ gfc_release_include_path (void) ...@@ -165,28 +180,30 @@ gfc_release_include_path (void)
gfc_free (p->path); gfc_free (p->path);
gfc_free (p); gfc_free (p);
} }
gfc_free (gfc_option.module_dir);
while (intrinsic_modules_dirs != NULL)
{
p = intrinsic_modules_dirs;
intrinsic_modules_dirs = intrinsic_modules_dirs->next;
gfc_free (p->path);
gfc_free (p);
}
} }
/* Opens file for reading, searching through the include directories
given if necessary. If the include_cwd argument is true, we try
to open the file in the current directory first. */
FILE * static FILE *
gfc_open_included_file (const char *name, const bool include_cwd) open_included_file (const char *name, gfc_directorylist *list, bool module)
{ {
char *fullname; char *fullname;
gfc_directorylist *p; gfc_directorylist *p;
FILE *f; FILE *f;
if (include_cwd) for (p = list; p; p = p->next)
{ {
f = gfc_open_file (name); if (module && !p->use_for_modules)
if (f != NULL) continue;
return f;
}
for (p = include_dirs; p; p = p->next)
{
fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1); fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1);
strcpy (fullname, p->path); strcpy (fullname, p->path);
strcat (fullname, name); strcat (fullname, name);
...@@ -199,6 +216,32 @@ gfc_open_included_file (const char *name, const bool include_cwd) ...@@ -199,6 +216,32 @@ gfc_open_included_file (const char *name, const bool include_cwd)
return NULL; return NULL;
} }
/* Opens file for reading, searching through the include directories
given if necessary. If the include_cwd argument is true, we try
to open the file in the current directory first. */
FILE *
gfc_open_included_file (const char *name, bool include_cwd, bool module)
{
FILE *f;
if (include_cwd)
{
f = gfc_open_file (name);
if (f != NULL)
return f;
}
return open_included_file (name, include_dirs, module);
}
FILE *
gfc_open_intrinsic_module (const char *name)
{
return open_included_file (name, intrinsic_modules_dirs, true);
}
/* Test to see if we're at the end of the main source file. */ /* Test to see if we're at the end of the main source file. */
int int
...@@ -1393,7 +1436,7 @@ load_file (const char *filename, bool initial) ...@@ -1393,7 +1436,7 @@ load_file (const char *filename, bool initial)
} }
else else
{ {
input = gfc_open_included_file (filename, false); input = gfc_open_included_file (filename, false, false);
if (input == NULL) if (input == NULL)
{ {
gfc_error_now ("Can't open included file '%s'", filename); gfc_error_now ("Can't open included file '%s'", filename);
......
2006-11-17 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* gfortran.dg/use_1.f90: New test.
* gfortran.dg/use_1.f90: New test.
* gfortran.dg/use_1.f90: New test.
2006-11-17 Zdenek Dvorak <dvorakz@suse.cz> 2006-11-17 Zdenek Dvorak <dvorakz@suse.cz>
PR tree-optimization/29801 PR tree-optimization/29801
! { dg-do compile }
! { dg-options "-ffixed-form" }
module foo
end module foo
subroutine bar1
usefoo
end
! { dg-final { cleanup-modules "iso_fortran_env" } }
! { dg-do compile }
subroutine bar1
usefoo ! { dg-error "Unclassifiable statement" }
end
! { dg-do compile }
module foo
end module foo
use foo
use :: foo
use, intrinsic iso_fortran_env ! { dg-error "\"::\" was expected after module nature" }
use, non_intrinsic iso_fortran_env ! { dg-error "\"::\" was expected after module nature" }
use, nonintrinsic :: iso_fortran_env ! { dg-error "shall be either INTRINSIC or NON_INTRINSIC" }
use, intrinsic :: iso_fortran_env ! { dg-error "Can't find an intrinsic module named" }
end
! { dg-final { cleanup-modules "foo" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment