2006-10-13 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29373
* decl.c (get_proc_name, gfc_match_function_decl): Add
attr.implicit_type to conditions that throw error for
existing explicit interface and that allow new type-
spec to be applied.
PR fortran/29407
* resolve.c (resolve_fl_namelist): Do not check for
namelist/procedure conflict, if the symbol corresponds
to a good local variable declaration.
PR fortran/27701
* decl.c (get_proc_name): Replace the detection of a declared
procedure by the presence of a formal argument list by the
attributes of the symbol and the presence of an explicit
interface.
PR fortran/29232
* resolve.c (resolve_fl_variable): See if the host association
of a derived type is blocked by the presence of another type I
object in the current namespace.
PR fortran/29364
* resolve.c (resolve_fl_derived): Check for the presence of
the derived type for a derived type component.
PR fortran/24398
* module.c (gfc_use_module): Check that the first words in a
module file are 'GFORTRAN module'.
PR fortran/29422
* resolve.c (resolve_transfer): Test functions for suitability
for IO, as well as variables.
PR fortran/29428
* trans-expr.c (gfc_trans_scalar_assign): Remove nullify of
rhs expression.
2006-10-13 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29373
* gfortran.dg/implicit_9.f90: New test.
PR fortran/29407
* gfortran.dg/namelist_25.f90: New test.
PR fortran/27701
* gfortran.dg/same_name_2.f90: New test.
PR fortran/29232
* gfortran.dg/host_assoc_types_1.f90: New test.
PR fortran/29364
* gfortran.dg/missing_derived_type_1.f90: New test.
* gfortran.dg/implicit_actual.f90: Comment out USE GLOBAL.
PR fortran/29422
* gfortran.dg/alloc_comp_constraint_4.f90: New test.
PR fortran/29428
* gfortran.dg/alloc_comp_assign_5.f90: New test.
From-SVN: r117692
+2006-10-13 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/29373
+ * decl.c (get_proc_name, gfc_match_function_decl): Add
+ attr.implicit_type to conditions that throw error for
+ existing explicit interface and that allow new type-
+ spec to be applied.
+
+ PR fortran/29407
+ * resolve.c (resolve_fl_namelist): Do not check for
+ namelist/procedure conflict, if the symbol corresponds
+ to a good local variable declaration.
+
+ PR fortran/27701
+ * decl.c (get_proc_name): Replace the detection of a declared
+ procedure by the presence of a formal argument list by the
+ attributes of the symbol and the presence of an explicit
+ interface.
+
+ PR fortran/29232
+ * resolve.c (resolve_fl_variable): See if the host association
+ of a derived type is blocked by the presence of another type I
+ object in the current namespace.
+
+ PR fortran/29364
+ * resolve.c (resolve_fl_derived): Check for the presence of
+ the derived type for a derived type component.
+
+ PR fortran/24398
+ * module.c (gfc_use_module): Check that the first words in a
+ module file are 'GFORTRAN module'.
+
+ PR fortran/29422
+ * resolve.c (resolve_transfer): Test functions for suitability
+ for IO, as well as variables.
+
+ PR fortran/29428
+ * trans-expr.c (gfc_trans_scalar_assign): Remove nullify of
+ rhs expression.
+
2006-10-13 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR fortran/29391
accessible names. */
if (sym->attr.flavor != 0
&& sym->attr.proc != 0
- && sym->formal)
+ && (sym->attr.subroutine || sym->attr.function)
+ && sym->attr.if_source != IFSRC_UNKNOWN)
gfc_error_now ("Procedure '%s' at %C is already defined at %L",
name, &sym->declared_at);
signature for this is that ts.kind is set. Legitimate
references only set ts.type. */
if (sym->ts.kind != 0
+ && !sym->attr.implicit_type
&& sym->attr.proc == 0
&& gfc_current_ns->parent != NULL
&& sym->attr.access == 0
|| copy_prefix (&sym->attr, &sym->declared_at) == FAILURE)
goto cleanup;
- if (current_ts.type != BT_UNKNOWN && sym->ts.type != BT_UNKNOWN)
+ if (current_ts.type != BT_UNKNOWN
+ && sym->ts.type != BT_UNKNOWN
+ && !sym->attr.implicit_type)
{
gfc_error ("Function '%s' at %C already has a type of %s", name,
gfc_basic_typename (sym->ts.type));
{
char *filename;
gfc_state_data *p;
- int c, line;
+ int c, line, start;
filename = (char *) alloca(strlen(module_name) + strlen(MODULE_EXTENSION)
+ 1);
iomode = IO_INPUT;
module_line = 1;
module_column = 1;
+ start = 0;
- /* Skip the first two lines of the module. */
- /* FIXME: Could also check for valid two lines here, instead. */
+ /* Skip the first two lines of the module, after checking that this is
+ a gfortran module file. */
line = 0;
while (line < 2)
{
c = module_char ();
if (c == EOF)
bad_module ("Unexpected end of module");
+ if (start++ < 2)
+ parse_name (c);
+ if ((start == 1 && strcmp (atom_name, "GFORTRAN") != 0)
+ || (start == 2 && strcmp (atom_name, " module") != 0))
+ gfc_fatal_error ("File '%s' opened at %C is not a GFORTRAN module "
+ "file", filename);
+
if (c == '\n')
line++;
}
exp = code->expr;
- if (exp->expr_type != EXPR_VARIABLE)
+ if (exp->expr_type != EXPR_VARIABLE
+ && exp->expr_type != EXPR_FUNCTION)
return;
sym = exp->symtree->n.sym;
return FAILURE;
}
+ /* Check to see if a derived type is blocked from being host associated
+ by the presence of another class I symbol in the same namespace.
+ 14.6.1.3 of the standard and the discussion on comp.lang.fortran. */
+ if (sym->ts.type == BT_DERIVED && sym->ns != sym->ts.derived->ns)
+ {
+ gfc_symbol *s;
+ gfc_find_symbol (sym->ts.derived->name, sym->ns, 0, &s);
+ if (s && (s->attr.flavor != FL_DERIVED
+ || !gfc_compare_derived_types (s, sym->ts.derived)))
+ {
+ gfc_error ("The type %s cannot be host associated at %L because "
+ "it is blocked by an incompatible object of the same "
+ "name at %L", sym->ts.derived->name, &sym->declared_at,
+ &s->declared_at);
+ return FAILURE;
+ }
+ }
+
/* 4th constraint in section 11.3: "If an object of a type for which
component-initialization is specified (R429) appears in the
specification-part of a module and does not have the ALLOCATABLE
}
}
+ if (c->ts.type == BT_DERIVED && c->pointer
+ && c->ts.derived->components == NULL)
+ {
+ gfc_error ("The pointer component '%s' of '%s' at %L is a type "
+ "that has not been declared", c->name, sym->name,
+ &c->loc);
+ return FAILURE;
+ }
+
if (c->pointer || c->allocatable || c->as == NULL)
continue;
same message has been used. */
for (nl = sym->namelist; nl; nl = nl->next)
{
+ if (nl->sym->ts.kind != 0 && nl->sym->attr.flavor == FL_VARIABLE)
+ continue;
nlsym = NULL;
- if (sym->ns->parent && nl->sym && nl->sym->name)
- gfc_find_symbol (nl->sym->name, sym->ns->parent, 0, &nlsym);
- if (nlsym && nlsym->attr.flavor == FL_PROCEDURE)
- {
- gfc_error ("PROCEDURE attribute conflicts with NAMELIST "
- "attribute in '%s' at %L", nlsym->name,
- &sym->declared_at);
- return FAILURE;
- }
+ if (sym->ns->parent && nl->sym && nl->sym->name)
+ gfc_find_symbol (nl->sym->name, sym->ns->parent, 0, &nlsym);
+ if (nlsym && nlsym->attr.flavor == FL_PROCEDURE)
+ {
+ gfc_error ("PROCEDURE attribute conflicts with NAMELIST "
+ "attribute in '%s' at %L", nlsym->name,
+ &sym->declared_at);
+ return FAILURE;
+ }
}
return SUCCESS;
fold_convert (TREE_TYPE (lse->expr), rse->expr));
/* Do a deep copy if the rhs is a variable, if it is not the
- same as the lhs. Otherwise, nullify the data fields so that the
- lhs retains the allocated resources. */
+ same as the lhs. */
if (r_is_var)
{
tmp = gfc_copy_alloc_comp (ts.derived, rse->expr, lse->expr, 0);
tmp = build3_v (COND_EXPR, cond, build_empty_stmt (), tmp);
gfc_add_expr_to_block (&block, tmp);
}
- else
- {
- tmp = gfc_nullify_alloc_comp (ts.derived, rse->expr, 0);
- gfc_add_expr_to_block (&block, tmp);
- }
}
else
{
+2006-10-13 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/29373
+ * gfortran.dg/implicit_9.f90: New test.
+
+ PR fortran/29407
+ * gfortran.dg/namelist_25.f90: New test.
+
+ PR fortran/27701
+ * gfortran.dg/same_name_2.f90: New test.
+
+ PR fortran/29232
+ * gfortran.dg/host_assoc_types_1.f90: New test.
+
+ PR fortran/29364
+ * gfortran.dg/missing_derived_type_1.f90: New test.
+ * gfortran.dg/implicit_actual.f90: Comment out USE GLOBAL.
+
+ PR fortran/29422
+ * gfortran.dg/alloc_comp_constraint_4.f90: New test.
+
+ PR fortran/29428
+ * gfortran.dg/alloc_comp_assign_5.f90: New test.
+
2006-10-13 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR fortran/29391
--- /dev/null
+! { dg-do run }
+! { dg-options "-O2" }
+! Tests the fix for PR29428, in which the assignment of
+! a function result would result in the function being
+! called twice, if it were not a result by reference,
+! because of a spurious nullify in gfc_trans_scalar_assign.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+program test
+implicit none
+
+ type A
+ integer, allocatable :: j(:)
+ end type A
+
+ type(A):: x
+ integer :: ctr = 0
+
+ x = f()
+
+ if (ctr /= 1) call abort ()
+
+contains
+
+ function f()
+ type(A):: f
+ ctr = ctr + 1
+ f = A ((/1,2/))
+ end function f
+
+end program
+
--- /dev/null
+! { dg-do compile }
+! Tests the fix for PR29422, in which function results
+! were not tested for suitability in IO statements.
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+!
+Type drv
+ Integer :: i
+ Integer, allocatable :: arr(:)
+End type drv
+
+ print *, fun1 () ! { dg-error "cannot have ALLOCATABLE" }
+
+contains
+ Function fun1 ()
+
+ Type(drv) :: fun1
+ fun1%i = 10
+ end function fun1
+end
+
--- /dev/null
+! { dg-do compile }
+! Tests the fix for PR29232, in which the invalid code below was not
+! diagnosed.
+!
+! Contributed by Tobias Burnus <tobias.burnus@physik.fu-berlin.de>
+!
+MODULE test
+ TYPE vertex
+ INTEGER :: k
+ END TYPE vertex
+CONTAINS
+ SUBROUTINE S1()
+ TYPE(vertex) :: a ! { dg-error "cannot be host associated" }
+ vertex : DO i=1,2 ! { dg-error "incompatible object of the same name" }
+ ENDDO vertex
+ END SUBROUTINE
+END MODULE test
+! { dg-final { cleanup-modules "test" } }
--- /dev/null
+! { dg-do compile }
+! Tests patch for PR29373, in which the implicit character
+! statement messes up the function declaration because the
+! requisite functions in decl.c were told nothing about
+! implicit types.
+!
+! Contributed by Tobias Schlueter <tobi@gcc.gnu.org>
+!
+ implicit character*32 (a-z)
+ CHARACTER(len=255), DIMENSION(1,2) :: a
+
+! Reporters original, which triggers another error:
+! gfc_todo: Not Implemented: complex character array
+! constructors.=> PR29431
+! a = reshape((/ to_string(1.0) /), (/ 1, 2 /))
+
+ a = to_string(1.0)
+ print *, a
+ CONTAINS
+ CHARACTER*(32) FUNCTION to_string(x)
+ REAL, INTENT(in) :: x
+ WRITE(to_string, FMT="(F6.3)") x
+ END FUNCTION
+END PROGRAM
! { dg-do compile }
-! { dg-options "-O0" }
! Tests patch for problem that was found whilst investigating
! PR24158. The call to foo would cause an ICE because the
-! actual argument was of a type that was not defined.
+! actual argument was of a type that was not defined. The USE
+! GLOBAL was commented out, following the fix for PR29364.
!
! Contributed by Paul Thomas <pault@gcc.gnu.org>
!
module global
type :: t2
- type(t3), pointer :: d
+ type(t3), pointer :: d ! { dg-error "has not been declared" }
end type t2
end module global
program snafu
- use global
+! use global
implicit type (t3) (z)
call foo (zin) ! { dg-error "defined|Type/rank" }
--- /dev/null
+! { dg-do compile }
+! Tests the fix for PR29364, in which the the absence of the derived type
+! 'nonexist' was not diagnosed.
+!
+! Contributed by Tobias Burnus <tobias.burnus@physik.fu-berlin.de>
+!
+module test
+ implicit none
+ type epot_t
+ integer :: c
+ type(nonexist),pointer :: l ! { dg-error "has not been declared" }
+ end type epot_t
+end module test
+! { dg-final { cleanup-modules "test" } }
--- /dev/null
+! { dg-do compile }
+! Tests patch for PR29407, in which the declaration of 'my' as
+! a local variable was ignored, so that the procedure and namelist
+! attributes for 'my' clashed..
+!
+! Contributed by Tobias Burnus <tobias.burnus@physik.fu-berlin.de>
+!
+program main
+ implicit none
+contains
+ subroutine my
+ end subroutine my
+ subroutine bar
+ integer :: my
+ namelist /ops/ my
+ end subroutine bar
+end program main
+
--- /dev/null
+! ( dg-do compile }
+! Tests the fix for PR27701, in which two same name procedures
+! were not diagnosed if they had no arguments.
+!
+! Contributed by Arjen Markus <arjen.markus@wldelft.nl>
+!
+module aha
+contains
+subroutine aa ! { dg-error "Procedure" }
+ write(*,*) 'AA'
+end subroutine aa
+subroutine aa ! { dg-error "is already defined" }
+ write(*,*) 'BB'
+end subroutine aa
+end module
+! { dg-final { cleanup-modules "aha" } }
projects / gcc.git / commitdiff