[multiple changes]
2007-08-18 Tobias Burnus <burnus@net-b.de> * gfortran.h (gfc_is_intrinsic_typename): Add declaration. * symbol.c (gfc_is_intrinsic_typename): New function. * parse.c (decode_statement): Check for space in ABSTRACT INTERFACE. (parse_interface): Use gfc_is_intrinsic_typename. * decl.c (gfc_match_derived_decl): Ditto. * module.c (gfc_match_use): Use gcc_unreachable() for INTERFACE_ABSTRACT in switch(). 2007-08-19 Tobias Burnus <burnus@net-b.de> * gfortran.dg/interface_abstract_2.f90: New. * gfortran.dg/interface_abstract_1.f90: Fix typo. From-SVN: r127626
This commit is contained in:
parent
434548f64f
commit
e9c0656362
9 changed files with 53 additions and 21 deletions
|
@ -1,3 +1,13 @@
|
|||
2007-08-18 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
* gfortran.h (gfc_is_intrinsic_typename): Add declaration.
|
||||
* symbol.c (gfc_is_intrinsic_typename): New function.
|
||||
* parse.c (decode_statement): Check for space in ABSTRACT INTERFACE.
|
||||
(parse_interface): Use gfc_is_intrinsic_typename.
|
||||
* decl.c (gfc_match_derived_decl): Ditto.
|
||||
* module.c (gfc_match_use): Use gcc_unreachable() for
|
||||
INTERFACE_ABSTRACT in switch().
|
||||
|
||||
2007-08-18 Roger Sayle <roger@eyesopen.com>
|
||||
|
||||
* primary.c (match_logical_constant_string): New function to match
|
||||
|
|
|
@ -5468,17 +5468,8 @@ gfc_match_derived_decl (void)
|
|||
if (m != MATCH_YES)
|
||||
return m;
|
||||
|
||||
/* Make sure the name isn't the name of an intrinsic type. The
|
||||
'double {precision,complex}' types don't get past the name
|
||||
matcher, unless they're written as a single word or in fixed
|
||||
form. */
|
||||
if (strcmp (name, "integer") == 0
|
||||
|| strcmp (name, "real") == 0
|
||||
|| strcmp (name, "character") == 0
|
||||
|| strcmp (name, "logical") == 0
|
||||
|| strcmp (name, "complex") == 0
|
||||
|| strcmp (name, "doubleprecision") == 0
|
||||
|| strcmp (name, "doublecomplex") == 0)
|
||||
/* Make sure the name is not the name of an intrinsic type. */
|
||||
if (gfc_is_intrinsic_typename (name))
|
||||
{
|
||||
gfc_error ("Type name '%s' at %C cannot be the same as an intrinsic "
|
||||
"type", name);
|
||||
|
|
|
@ -2056,6 +2056,7 @@ try gfc_add_new_implicit_range (int, int);
|
|||
try gfc_merge_new_implicit (gfc_typespec *);
|
||||
void gfc_set_implicit_none (void);
|
||||
void gfc_check_function_type (gfc_namespace *);
|
||||
bool gfc_is_intrinsic_typename (const char *);
|
||||
|
||||
gfc_typespec *gfc_get_default_type (gfc_symbol *, gfc_namespace *);
|
||||
try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
|
||||
|
|
|
@ -599,7 +599,6 @@ gfc_match_use (void)
|
|||
switch (type)
|
||||
{
|
||||
case INTERFACE_NAMELESS:
|
||||
case INTERFACE_ABSTRACT:
|
||||
gfc_error ("Missing generic specification in USE statement at %C");
|
||||
goto cleanup;
|
||||
|
||||
|
@ -659,6 +658,9 @@ gfc_match_use (void)
|
|||
case INTERFACE_INTRINSIC_OP:
|
||||
new->operator = operator;
|
||||
break;
|
||||
|
||||
default:
|
||||
gcc_unreachable ();
|
||||
}
|
||||
|
||||
if (gfc_match_eos () == MATCH_YES)
|
||||
|
|
|
@ -172,7 +172,8 @@ decode_statement (void)
|
|||
switch (c)
|
||||
{
|
||||
case 'a':
|
||||
match ("abstract interface", gfc_match_abstract_interface, ST_INTERFACE);
|
||||
match ("abstract% interface", gfc_match_abstract_interface,
|
||||
ST_INTERFACE);
|
||||
match ("allocate", gfc_match_allocate, ST_ALLOCATE);
|
||||
match ("allocatable", gfc_match_allocatable, ST_ATTR_DECL);
|
||||
match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT);
|
||||
|
@ -1799,13 +1800,10 @@ loop:
|
|||
if (current_interface.type == INTERFACE_ABSTRACT)
|
||||
{
|
||||
gfc_new_block->attr.abstract = 1;
|
||||
if (!strcmp(gfc_new_block->name,"integer")
|
||||
|| !strcmp(gfc_new_block->name,"real")
|
||||
|| !strcmp(gfc_new_block->name,"complex")
|
||||
|| !strcmp(gfc_new_block->name,"character")
|
||||
|| !strcmp(gfc_new_block->name,"logical"))
|
||||
gfc_error ("Name of ABSTRACT INTERFACE at %C cannot be the same as "
|
||||
"an intrinsic type: %s",gfc_new_block->name);
|
||||
if (gfc_is_intrinsic_typename (gfc_new_block->name))
|
||||
gfc_error ("Name '%s' of ABSTRACT INTERFACE at %C "
|
||||
"cannot be the same as an intrinsic type",
|
||||
gfc_new_block->name);
|
||||
}
|
||||
|
||||
push_state (&s2, new_state, gfc_new_block);
|
||||
|
|
|
@ -2909,6 +2909,24 @@ gfc_traverse_ns (gfc_namespace *ns, void (*func) (gfc_symbol *))
|
|||
}
|
||||
|
||||
|
||||
/* Return TRUE when name is the name of an intrinsic type. */
|
||||
|
||||
bool
|
||||
gfc_is_intrinsic_typename (const char *name)
|
||||
{
|
||||
if (strcmp (name, "integer") == 0
|
||||
|| strcmp (name, "real") == 0
|
||||
|| strcmp (name, "character") == 0
|
||||
|| strcmp (name, "logical") == 0
|
||||
|| strcmp (name, "complex") == 0
|
||||
|| strcmp (name, "doubleprecision") == 0
|
||||
|| strcmp (name, "doublecomplex") == 0)
|
||||
return true;
|
||||
else
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
/* Return TRUE if the symbol is an automatic variable. */
|
||||
|
||||
static bool
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2007-08-19 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
* gfortran.dg/interface_abstract_2.f90: New.
|
||||
* gfortran.dg/interface_abstract_1.f90: Fix typo.
|
||||
|
||||
2007-08-19 Dorit Nuzman <dorit@il.ibm.com>
|
||||
|
||||
* gcc.dg/vect/vect-117.c: Change inner-loop bound to
|
||||
|
|
|
@ -9,7 +9,7 @@ abstract interface
|
|||
end subroutine two
|
||||
subroutine three() bind(C,name="three") ! { dg-error "NAME not allowed on BIND.C. for ABSTRACT INTERFACE" }
|
||||
end subroutine three ! { dg-error "Expecting END INTERFACE statement" }
|
||||
subroutine real() ! { dg-error "cannot be be the same as an intrinsic type" }
|
||||
subroutine real() ! { dg-error "cannot be the same as an intrinsic type" }
|
||||
end subroutine real
|
||||
end interface
|
||||
end
|
||||
|
|
7
gcc/testsuite/gfortran.dg/interface_abstract_2.f90
Normal file
7
gcc/testsuite/gfortran.dg/interface_abstract_2.f90
Normal file
|
@ -0,0 +1,7 @@
|
|||
! { dg-do compile }
|
||||
! { dg-options "-std=f95" }
|
||||
abstract interface ! { dg-error "Fortran 2003: ABSTRACT INTERFACE" }
|
||||
subroutine two()
|
||||
end subroutine two
|
||||
end interface ! { dg-error "Expecting END PROGRAM statement" }
|
||||
end
|
Loading…
Add table
Reference in a new issue