OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/16404 (should reject invalid code with -pedantic -std=f95 ? (x8)) 

2005-10-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/16404
	PR fortran/20835
	PR fortran/20890
	PR fortran/20899
	PR fortran/20900
	PR fortran/20901
	PR fortran/20902
	* gfortran.h: Prototype for gfc_add_in_equivalence.
	* match.c (gfc_match_equivalence): Make a structure component
	an explicit,rather than a syntax, error in an equivalence
	group.  Call gfc_add_in_equivalence to add the constraints
	imposed in check_conflict.
	* resolve.c (resolve_symbol): Add constraints: No public
	structures with private-type components and no public
	procedures with private-type dummy arguments.
	(resolve_equivalence_derived): Add constraint that prevents
	a structure equivalence member from having a default
	initializer.
	(sequence_type): New static function to determine whether an
	object is default numeric, default character, non-default
	or mixed sequence. Add corresponding enum typespec.
	(resolve_equivalence): Add constraints to equivalence groups
	or their members: No more than one initialized member and
	that different types are not equivalenced for std=f95.  All
	the simple constraints have been moved to check_conflict.
	* symbol.c (check_conflict): Simple equivalence constraints
	added, including those removed from resolve_symbol.
	(gfc_add_in_equivalence): New function to interface calls
	match_equivalence to check_conflict.

2005-10-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/16404
	PR fortran/20835
	PR fortran/20890
	PR fortran/20899
	PR fortran/20900
	PR fortran/20901
	PR fortran/20902
	gfortran.dg/equiv_constraint_1.f90: New test.
	gfortran.dg/equiv_constraint_2.f90: New test.
	gfortran.dg/equiv_constraint_3.f90: New test.
	gfortran.dg/equiv_constraint_4.f90: New test.
	gfortran.dg/equiv_constraint_5.f90: New test.
	gfortran.dg/equiv_constraint_6.f90: New test.
	gfortran.dg/equiv_constraint_7.f90: New test.
	gfortran.dg/equiv_constraint_8.f90: New test.
	gfortran.dg/private_type_1.f90: New test.
	gfortran.dg/private_type_2.f90: New test.
	gfortran.dg/g77/980628-2.f, 980628-3.f, 980628-9.f,
	980628-10.f: Assert std=gnu to permit mixing of
	types in equivalence statements.

From-SVN: r104850
This commit is contained in:
Paul Thomas 2005-10-01 07:39:08 +00:00
parent 0363db460d
commit e8ec07e1ec
20 changed files with 523 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
gcc/fortran/ChangeLog
View File

@ -1,3 +1,35 @@
2005-10-01 Paul Thomas <pault@gcc.gnu.org>
PR fortran/16404
PR fortran/20835
PR fortran/20890
PR fortran/20899
PR fortran/20900
PR fortran/20901
PR fortran/20902
* gfortran.h: Prototype for gfc_add_in_equivalence.
* match.c (gfc_match_equivalence): Make a structure component
an explicit,rather than a syntax, error in an equivalence
group. Call gfc_add_in_equivalence to add the constraints
imposed in check_conflict.
* resolve.c (resolve_symbol): Add constraints: No public
structures with private-type components and no public
procedures with private-type dummy arguments.
(resolve_equivalence_derived): Add constraint that prevents
a structure equivalence member from having a default
initializer.
(sequence_type): New static function to determine whether an
object is default numeric, default character, non-default
or mixed sequence. Add corresponding enum typespec.
(resolve_equivalence): Add constraints to equivalence groups
or their members: No more than one initialized member and
that different types are not equivalenced for std=f95. All
the simple constraints have been moved to check_conflict.
* symbol.c (check_conflict): Simple equivalence constraints
added, including those removed from resolve_symbol.
(gfc_add_in_equivalence): New function to interface calls
match_equivalence to check_conflict.
2005-09-27 Jakub Jelinek <jakub@redhat.com>
PR fortran/18518

1
gcc/fortran/gfortran.h
View File

@ -1639,6 +1639,7 @@ try gfc_add_dummy (symbol_attribute *, const char *, locus *);
try gfc_add_generic (symbol_attribute *, const char *, locus *);
try gfc_add_common (symbol_attribute *, locus *);
try gfc_add_in_common (symbol_attribute *, const char *, locus *);
try gfc_add_in_equivalence (symbol_attribute *, const char *, locus *);
try gfc_add_data (symbol_attribute *, const char *, locus *);
try gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
try gfc_add_sequence (symbol_attribute *, const char *, locus *);

19
gcc/fortran/match.c
View File

@ -2622,6 +2622,13 @@ gfc_match_equivalence (void)
if (m == MATCH_NO)
goto syntax;
if (gfc_match_char ('%') == MATCH_YES)
{
gfc_error ("Derived type component %C is not a "
"permitted EQUIVALENCE member");
goto cleanup;
}
for (ref = set->expr->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
{
@ -2631,14 +2638,18 @@ gfc_match_equivalence (void)
goto cleanup;
}
if (set->expr->symtree->n.sym->attr.in_common)
sym = set->expr->symtree->n.sym;
if (gfc_add_in_equivalence (&sym->attr, sym->name, NULL)
== FAILURE)
goto cleanup;
if (sym->attr.in_common)
{
common_flag = TRUE;
common_head = set->expr->symtree->n.sym->common_head;
common_head = sym->common_head;
}
set->expr->symtree->n.sym->attr.in_equivalence = 1;
if (gfc_match_char (')') == MATCH_YES)
break;
if (gfc_match_char (',') != MATCH_YES)

257
gcc/fortran/resolve.c
View File

@ -25,6 +25,13 @@ Software Foundation, 51 Franklin Street, Fifth Floor,Boston, MA
#include "gfortran.h"
#include "arith.h" /* For gfc_compare_expr(). */
/* Types used in equivalence statements. */
typedef enum seq_type
{
SEQ_NONDEFAULT, SEQ_NUMERIC, SEQ_CHARACTER, SEQ_MIXED
}
seq_type;
/* Stack to push the current if we descend into a block during
resolution. See resolve_branch() and resolve_code(). */
@ -4124,6 +4131,8 @@ resolve_symbol (gfc_symbol * sym)
gfc_symtree * symtree;
gfc_symtree * this_symtree;
gfc_namespace * ns;
gfc_component * c;
gfc_formal_arglist * arg;
if (sym->attr.flavor == FL_UNKNOWN)
{
@ -4274,6 +4283,48 @@ resolve_symbol (gfc_symbol * sym)
}
}
/* Ensure that derived type components of a public derived type
are not of a private type. */
if (sym->attr.flavor == FL_DERIVED
&& gfc_check_access(sym->attr.access, sym->ns->default_access))
{
for (c = sym->components; c; c = c->next)
{
if (c->ts.type == BT_DERIVED
&& !c->ts.derived->attr.use_assoc
&& !gfc_check_access(c->ts.derived->attr.access,
c->ts.derived->ns->default_access))
{
gfc_error ("The component '%s' is a PRIVATE type and cannot be "
"a component of '%s', which is PUBLIC at %L",
c->name, sym->name, &sym->declared_at);
return;
}
}
}
/* Ensure that derived type formal arguments of a public procedure
are not of a private type. */
if (sym->attr.flavor == FL_PROCEDURE
&& gfc_check_access(sym->attr.access, sym->ns->default_access))
{
for (arg = sym->formal; arg; arg = arg->next)
{
if (arg->sym
&& arg->sym->ts.type == BT_DERIVED
&& !gfc_check_access(arg->sym->ts.derived->attr.access,
arg->sym->ts.derived->ns->default_access))
{
gfc_error_now ("'%s' is a PRIVATE type and cannot be "
"a dummy argument of '%s', which is PUBLIC at %L",
arg->sym->name, sym->name, &sym->declared_at);
/* Stop this message from recurring. */
arg->sym->ts.derived->attr.access = ACCESS_PUBLIC;
return;
}
}
}
/* Constraints on deferred shape variable. */
if (sym->attr.flavor == FL_VARIABLE
|| (sym->attr.flavor == FL_PROCEDURE
@ -4802,6 +4853,65 @@ warn_unused_label (gfc_namespace * ns)
}
/* Returns the sequence type of a symbol or sequence. */
static seq_type
sequence_type (gfc_typespec ts)
{
seq_type result;
gfc_component *c;
switch (ts.type)
{
case BT_DERIVED:
if (ts.derived->components == NULL)
return SEQ_NONDEFAULT;
result = sequence_type (ts.derived->components->ts);
for (c = ts.derived->components->next; c; c = c->next)
if (sequence_type (c->ts) != result)
return SEQ_MIXED;
return result;
case BT_CHARACTER:
if (ts.kind != gfc_default_character_kind)
return SEQ_NONDEFAULT;
return SEQ_CHARACTER;
case BT_INTEGER:
if (ts.kind != gfc_default_integer_kind)
return SEQ_NONDEFAULT;
return SEQ_NUMERIC;
case BT_REAL:
if (!(ts.kind == gfc_default_real_kind
|| ts.kind == gfc_default_double_kind))
return SEQ_NONDEFAULT;
return SEQ_NUMERIC;
case BT_COMPLEX:
if (ts.kind != gfc_default_complex_kind)
return SEQ_NONDEFAULT;
return SEQ_NUMERIC;
case BT_LOGICAL:
if (ts.kind != gfc_default_logical_kind)
return SEQ_NONDEFAULT;
return SEQ_NUMERIC;
default:
return SEQ_NONDEFAULT;
}
}
/* Resolve derived type EQUIVALENCE object. */
static try
@ -4831,7 +4941,14 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
in the structure. */
if (c->pointer)
{
gfc_error ("Derived type variable '%s' at %L has pointer componet(s) "
gfc_error ("Derived type variable '%s' at %L with pointer component(s) "
"cannot be an EQUIVALENCE object", sym->name, &e->where);
return FAILURE;
}
if (c->initializer)
{
gfc_error ("Derived type variable '%s' at %L with default initializer "
"cannot be an EQUIVALENCE object", sym->name, &e->where);
return FAILURE;
}
@ -4841,22 +4958,38 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
/* Resolve equivalence object.
An EQUIVALENCE object shall not be a dummy argument, a pointer, an
allocatable array, an object of nonsequence derived type, an object of
An EQUIVALENCE object shall not be a dummy argument, a pointer, a target,
an allocatable array, an object of nonsequence derived type, an object of
sequence derived type containing a pointer at any level of component
selection, an automatic object, a function name, an entry name, a result
name, a named constant, a structure component, or a subobject of any of
the preceding objects. A substring shall not have length zero. */
the preceding objects. A substring shall not have length zero. A
derived type shall not have components with default initialization nor
shall two objects of an equivalence group be initialized.
The simple constraints are done in symbol.c(check_conflict) and the rest
are implemented here. */
static void
resolve_equivalence (gfc_equiv *eq)
{
gfc_symbol *sym;
gfc_symbol *derived;
gfc_symbol *first_sym;
gfc_expr *e;
gfc_ref *r;
locus *last_where = NULL;
seq_type eq_type, last_eq_type;
gfc_typespec *last_ts;
int object;
const char *value_name;
const char *msg;
for (; eq; eq = eq->eq)
value_name = NULL;
last_ts = &eq->expr->symtree->n.sym->ts;
first_sym = eq->expr->symtree->n.sym;
for (object = 1; eq; eq = eq->eq, object++)
{
e = eq->expr;
@ -4926,38 +5059,31 @@ resolve_equivalence (gfc_equiv *eq)
continue;
sym = e->symtree->n.sym;
/* Shall not be a dummy argument. */
if (sym->attr.dummy)
{
gfc_error ("Dummy argument '%s' at %L cannot be an EQUIVALENCE "
"object", sym->name, &e->where);
continue;
}
/* Shall not be an allocatable array. */
if (sym->attr.allocatable)
{
gfc_error ("Allocatable array '%s' at %L cannot be an EQUIVALENCE "
"object", sym->name, &e->where);
continue;
}
/* An equivalence statement cannot have more than one initialized
object. */
if (sym->value)
{
if (value_name != NULL)
{
gfc_error ("Initialized objects '%s' and '%s' cannot both "
"be in the EQUIVALENCE statement at %L",
value_name, sym->name, &e->where);
continue;
}
else
value_name = sym->name;
}
/* Shall not be a pointer. */
if (sym->attr.pointer)
/* Shall not equivalence common block variables in a PURE procedure. */
if (sym->ns->proc_name
&& sym->ns->proc_name->attr.pure
&& sym->attr.in_common)
{
gfc_error ("Pointer '%s' at %L cannot be an EQUIVALENCE object",
sym->name, &e->where);
continue;
}
/* Shall not be a function name, ... */
if (sym->attr.function || sym->attr.result || sym->attr.entry
|| sym->attr.subroutine)
{
gfc_error ("Entity '%s' at %L cannot be an EQUIVALENCE object",
sym->name, &e->where);
continue;
gfc_error ("Common block member '%s' at %L cannot be an EQUIVALENCE "
"object in the pure procedure '%s'",
sym->name, &e->where, sym->ns->proc_name->name);
break;
}
/* Shall not be a named constant. */
@ -4972,6 +5098,69 @@ resolve_equivalence (gfc_equiv *eq)
if (derived && resolve_equivalence_derived (derived, sym, e) == FAILURE)
continue;
/* Check that the types correspond correctly:
Note 5.28:
A numeric sequence structure may be equivalenced to another sequence
structure, an object of default integer type, default real type, double
precision real type, default logical type such that components of the
structure ultimately only become associated to objects of the same
kind. A character sequence structure may be equivalenced to an object
of default character kind or another character sequence structure.
Other objects may be equivalenced only to objects of the same type and
kind parameters. */
/* Identical types are unconditionally OK. */
if (object == 1 || gfc_compare_types (last_ts, &sym->ts))
goto identical_types;
last_eq_type = sequence_type (*last_ts);
eq_type = sequence_type (sym->ts);
/* Since the pair of objects is not of the same type, mixed or
non-default sequences can be rejected. */
msg = "Sequence %s with mixed components in EQUIVALENCE "
"statement at %L with different type objects";
if ((object ==2
&& last_eq_type == SEQ_MIXED
&& gfc_notify_std (GFC_STD_GNU, msg, first_sym->name,
last_where) == FAILURE)
|| (eq_type == SEQ_MIXED
&& gfc_notify_std (GFC_STD_GNU, msg,sym->name,
&e->where) == FAILURE))
continue;
msg = "Non-default type object or sequence %s in EQUIVALENCE "
"statement at %L with objects of different type";
if ((object ==2
&& last_eq_type == SEQ_NONDEFAULT
&& gfc_notify_std (GFC_STD_GNU, msg, first_sym->name,
last_where) == FAILURE)
|| (eq_type == SEQ_NONDEFAULT
&& gfc_notify_std (GFC_STD_GNU, msg, sym->name,
&e->where) == FAILURE))
continue;
msg ="Non-CHARACTER object '%s' in default CHARACTER "
"EQUIVALENCE statement at %L";
if (last_eq_type == SEQ_CHARACTER
&& eq_type != SEQ_CHARACTER
&& gfc_notify_std (GFC_STD_GNU, msg, sym->name,
&e->where) == FAILURE)
continue;
msg ="Non-NUMERIC object '%s' in default NUMERIC "
"EQUIVALENCE statement at %L";
if (last_eq_type == SEQ_NUMERIC
&& eq_type != SEQ_NUMERIC
&& gfc_notify_std (GFC_STD_GNU, msg, sym->name,
&e->where) == FAILURE)
continue;
identical_types:
last_ts =&sym->ts;
last_where = &e->where;
if (!e->ref)
continue;

27
gcc/fortran/symbol.c
View File

@ -262,7 +262,8 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
*in_common = "COMMON", *result = "RESULT", *in_namelist = "NAMELIST",
*public = "PUBLIC", *optional = "OPTIONAL", *entry = "ENTRY",
*function = "FUNCTION", *subroutine = "SUBROUTINE",
*dimension = "DIMENSION";
*dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE",
*use_assoc = "USE ASSOCIATED";
const char *a1, *a2;
@ -323,6 +324,15 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
conf (in_common, result);
conf (dummy, result);
conf (in_equivalence, use_assoc);
conf (in_equivalence, dummy);
conf (in_equivalence, target);
conf (in_equivalence, pointer);
conf (in_equivalence, function);
conf (in_equivalence, result);
conf (in_equivalence, entry);
conf (in_equivalence, allocatable);
conf (in_namelist, pointer);
conf (in_namelist, allocatable);
@ -726,6 +736,21 @@ gfc_add_in_common (symbol_attribute * attr, const char *name, locus * where)
return gfc_add_flavor (attr, FL_VARIABLE, name, where);
}
try
gfc_add_in_equivalence (symbol_attribute * attr, const char *name, locus * where)
{
/* Duplicate attribute already checked for. */
attr->in_equivalence = 1;
if (check_conflict (attr, name, where) == FAILURE)
return FAILURE;
if (attr->flavor == FL_VARIABLE)
return SUCCESS;
return gfc_add_flavor (attr, FL_VARIABLE, name, where);
}
try
gfc_add_data (symbol_attribute *attr, const char *name, locus *where)

23
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,26 @@
2005-10-01 Paul Thomas <pault@gcc.gnu.org>
PR fortran/16404
PR fortran/20835
PR fortran/20890
PR fortran/20899
PR fortran/20900
PR fortran/20901
PR fortran/20902
gfortran.dg/equiv_constraint_1.f90: New test.
gfortran.dg/equiv_constraint_2.f90: New test.
gfortran.dg/equiv_constraint_3.f90: New test.
gfortran.dg/equiv_constraint_4.f90: New test.
gfortran.dg/equiv_constraint_5.f90: New test.
gfortran.dg/equiv_constraint_6.f90: New test.
gfortran.dg/equiv_constraint_7.f90: New test.
gfortran.dg/equiv_constraint_8.f90: New test.
gfortran.dg/private_type_1.f90: New test.
gfortran.dg/private_type_2.f90: New test.
gfortran.dg/g77/980628-2.f, 980628-3.f, 980628-9.f,
980628-10.f: Assert std=gnu to permit mixing of
types in equivalence statements.
2005-09-30 Janne Blomqvist <jblomqvi@cc.hut.fi>
PR 24112

10
gcc/testsuite/gfortran.dg/equiv_constraint_1.f90 Normal file
View File

@ -0,0 +1,10 @@
! { dg-do compile }
! { dg-options "-std=f95" }
! PR20901 - F95 constrains mixing of types in equivalence.
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
character(len=4) :: a
integer :: i
equivalence(a,i) ! { dg-error "in default CHARACTER EQUIVALENCE statement at" }
END

74
gcc/testsuite/gfortran.dg/equiv_constraint_2.f90 Normal file
View File

@ -0,0 +1,74 @@
! { dg-do compile }
! { dg-options "-std=f95" }
!
! PR20901 - Checks resolution of types in EQUIVALENCE statement when
! f95 standard is imposed.
!
! Contributed by Paul Thomas <pault@gcc.gnu.org>
!
type :: numeric_type
sequence
integer :: i
real :: x
real*8 :: d
complex :: z
logical :: l
end type numeric_type
type (numeric_type) :: my_num, thy_num
type :: numeric_type2
sequence
integer :: i
real :: x
real*8 :: d
complex :: z
logical :: l
end type numeric_type2
type (numeric_type2) :: his_num
type :: char_type
sequence
character*4 :: ch
character*4 :: cha (6)
end type char_type
type (char_type) :: my_char
type :: mixed_type
sequence
integer*4 :: i(4)
character*4 :: cha (6)
end type mixed_type
type (mixed_type) :: my_mixed, thy_mixed
character(len=4) :: ch
integer :: num
integer*8 :: non_def
complex*16 :: my_z, thy_z
! Permitted: character with character sequence
! numeric with numeric sequence
! numeric sequence with numeric sequence
! non-default of same type
! mixed sequences of same type
equivalence (ch, my_char)
equivalence (num, my_num)
equivalence (my_num, his_num, thy_num)
equivalence (my_z, thy_z)
equivalence (my_mixed, thy_mixed)
! Not permitted by the standard - OK with -std=gnu
equivalence (my_mixed, my_num) ! { dg-error "with mixed components in EQUIVALENCE" }
equivalence (my_z, num) ! { dg-error "Non-default type object or sequence" }
equivalence (my_char, my_num) ! { dg-error "in default CHARACTER EQUIVALENCE" }
equivalence (ch, my_num) ! { dg-error "in default CHARACTER EQUIVALENCE" }
equivalence (my_num, ch) ! { dg-error "in default NUMERIC EQUIVALENCE" }
equivalence (num, my_char) ! { dg-error "in default NUMERIC EQUIVALENCE" }
equivalence (my_char, num) ! { dg-error "in default CHARACTER EQUIVALENCE" }
equivalence (non_def, ch) ! { dg-error "Non-default type object or sequence" }
equivalence (my_z, ch) ! { dg-error "Non-default type object or sequence" }
equivalence (my_z, num) ! { dg-error "Non-default type object or sequence" }
END

13
gcc/testsuite/gfortran.dg/equiv_constraint_3.f90 Normal file
View File

@ -0,0 +1,13 @@
! { dg-do compile }
! PR20900 - USE associated variables cannot be equivalenced.
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
MODULE TEST
INTEGER :: I
END MODULE
! note 11.7
USE TEST, ONLY : K=>I
INTEGER :: L
EQUIVALENCE(K,L) ! { dg-error "conflicts with USE ASSOCIATED attribute" }
END

16
gcc/testsuite/gfortran.dg/equiv_constraint_4.f90 Normal file
View File

@ -0,0 +1,16 @@
! { dg-do run }
! { dg-options "-O0" }
! PR20901 - check that derived/numeric equivalence works with std!=f95.
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
TYPE data_type
SEQUENCE
INTEGER :: I
END TYPE data_type
INTEGER :: J = 7
TYPE(data_type) :: dd
EQUIVALENCE(dd,J)
if (dd%i.ne.7) call abort ()
END

18
gcc/testsuite/gfortran.dg/equiv_constraint_5.f90 Normal file
View File

@ -0,0 +1,18 @@
! { dg-do compile }
! { dg-options "-O0" }
! PR20902 - Structure with default initializer cannot be equivalence memeber.
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
TYPE T1
sequence
integer :: i=1
END TYPE T1
TYPE T2
sequence
integer :: i ! drop original initializer to pick up error below.
END TYPE T2
TYPE(T1) :: a1
TYPE(T2) :: a2
EQUIVALENCE(a1,a2) ! { dg-error "initializer cannot be an EQUIVALENCE" }
write(6,*) a1,a2
END

8
gcc/testsuite/gfortran.dg/equiv_constraint_6.f90 Normal file
View File

@ -0,0 +1,8 @@
! { dg-do compile }
! PR16404 test 3 and PR20835 - Target cannot be equivalence object.
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
REAL :: A
REAL, TARGET :: B
EQUIVALENCE(A,B) ! { dg-error "conflicts with TARGET attribute" }
END

9
gcc/testsuite/gfortran.dg/equiv_constraint_7.f90 Normal file
View File

@ -0,0 +1,9 @@
! { dg-do compile }
! { dg-options "-O0" }
! PR20890 - Equivalence cannot contain more than one initialized variables.
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
BLOCK DATA
INTEGER :: I=1,J=2
EQUIVALENCE(I,J) ! { dg-error "cannot both be in the EQUIVALENCE" }
END BLOCK DATA
END

16
gcc/testsuite/gfortran.dg/equiv_constraint_8.f90 Normal file
View File

@ -0,0 +1,16 @@
! { dg-do compile }
! { dg-options "-O0" }
! PR20899 - Common block variables cannot be equivalenced in a pure procedure.
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
common /z/ i
contains
pure integer function test(j)
integer, intent(in) :: j
common /z/ i
integer :: k
equivalence(i,k) ! { dg-error "EQUIVALENCE object in the pure" }
k=1 ! { dg-error "in PURE procedure at" }
test=i*j
end function test
end

1
gcc/testsuite/gfortran.dg/g77/980628-10.f
View File

@ -1,4 +1,5 @@
c { dg-do run }
c { dg-options "-std=gnu" }
* g77 0.5.23 and previous had bugs involving too little space
* allocated for EQUIVALENCE and COMMON areas needing initial
* padding to meet alignment requirements of the system.

1
gcc/testsuite/gfortran.dg/g77/980628-2.f
View File

@ -1,4 +1,5 @@
c { dg-do run }
c { dg-options "-std=gnu" }
* g77 0.5.23 and previous had bugs involving too little space
* allocated for EQUIVALENCE and COMMON areas needing initial
* padding to meet alignment requirements of the system.

2
gcc/testsuite/gfortran.dg/g77/980628-3.f
View File

@ -1,4 +1,6 @@
c { dg-do run }
c { dg-options "-std=gnu" }
c
* g77 0.5.23 and previous had bugs involving too little space
* allocated for EQUIVALENCE and COMMON areas needing initial
* padding to meet alignment requirements of the system.

1
gcc/testsuite/gfortran.dg/g77/980628-9.f
View File

@ -1,4 +1,5 @@
c { dg-do run }
c { dg-options "-std=gnu" }
* g77 0.5.23 and previous had bugs involving too little space
* allocated for EQUIVALENCE and COMMON areas needing initial
* padding to meet alignment requirements of the system.

19
gcc/testsuite/gfortran.dg/private_type_1.f90 Normal file
View File

@ -0,0 +1,19 @@
! { dg-do compile }
! PR21986 - test based on original example.
! A public subroutine must not have private-type, dummy arguments.
! Contributed by Paul Thomas <pault@gcc.gnu.org>
module modboom
implicit none
private
public:: dummysub ! { dg-error "PRIVATE type and cannot be a dummy argument" }
type:: intwrapper
integer n
end type intwrapper
contains
subroutine dummysub(size, arg_array)
type(intwrapper) :: size
real, dimension(size%n) :: arg_array
real :: local_array(4)
end subroutine dummysub
end module modboom

15
gcc/testsuite/gfortran.dg/private_type_2.f90 Normal file
View File

@ -0,0 +1,15 @@
! { dg-do compile }
! PR16404 test 6 - A public type cannot have private-type components.
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
MODULE TEST
PRIVATE
TYPE :: info_type
INTEGER :: value
END TYPE info_type
TYPE :: all_type! { dg-error "PRIVATE type and cannot be a component" }
TYPE(info_type) :: info
END TYPE
public all_type
END MODULE
END