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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@104850
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
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 *);
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)
{
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)
#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(). */
gfc_symtree * symtree;
gfc_symtree * this_symtree;
gfc_namespace * ns;
+ gfc_component * c;
+ gfc_formal_arglist * arg;
if (sym->attr.flavor == FL_UNKNOWN)
{
}
}
+ /* 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
}
+/* 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
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;
}
/* 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;
+
+ value_name = NULL;
+ last_ts = &eq->expr->symtree->n.sym->ts;
- for (; eq; eq = eq->eq)
+ first_sym = eq->expr->symtree->n.sym;
+
+ for (object = 1; eq; eq = eq->eq, object++)
{
e = eq->expr;
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. */
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;
*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;
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);
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)
+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
--- /dev/null
+! { 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
+
+
--- /dev/null
+! { 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
--- /dev/null
+! { 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
+
+
--- /dev/null
+! { 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
+
+
+
--- /dev/null
+! { 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
+
--- /dev/null
+! { 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
+
--- /dev/null
+! { 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
--- /dev/null
+! { 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
+
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.
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.
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.
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.
--- /dev/null
+! { 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
+
--- /dev/null
+! { 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
+
OSDN Git Service
