2008-07-30 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk r138310

	* gcc/Makefile.in: removed debugging echo in run-basilys-deps



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@138312 138bc75d-0d04-0410-961f-82ee72b054a4

16 files changed, 479 insertions, 150 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 720626302f3..38a653aad68 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,63 @@
+2008-07-30  Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
+
+	* gfc-internals.texi: Update to GFDL 1.2.  Do not list GPL as
+	Invariant Section.
+	* gfortran.texi: Likewise.
+	* intrinsic.texi: Do not list GPL as Invariant Section.
+	* invoke.texi: Likewise.  Update copyright years.
+
+2008-07-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	* trans-expr.c (conv_parent_component_references): New function
+	to build missing parent references.
+	(gfc_conv_variable): Call it
+	* symbol.c (gfc_add_component): Check that component name in a
+	derived type extension does not appear in parent.
+	(gfc_find_component): For a derived type extension, check if
+	the component appears in the parent derived type by calling
+	self. Separate errors for private components and private types.
+	* decl.c (match_data_constant): Add extra arg to call to
+	gfc_match_structure_constructor.
+	(check_extended_derived_type): New function to check that a
+	parent derived type exists and that it is OK for exension.
+	(gfc_get_type_attr_spec): Add extra argument 'name' and return
+	it if extends is specified.
+	(gfc_match_derived_decl): Match derived type extension and
+	build a first component of the parent derived type if OK. Add
+	the f2k namespace if not present.
+	* gfortran.h : Add the extension attribute.
+	* module.c : Handle attribute 'extension'.
+	* match.h : Modify prototypes for gfc_get_type_attr_spec and
+	gfc_match_structure_constructor.
+	* primary.c (build_actual_constructor): New function extracted
+	from gfc_match_structure_constructor and modified to call self
+	iteratively to build derived type extensions, when f2k named
+	components are used.
+	(gfc_match_structure_constructor): Do not throw error for too
+	many components if a parent type is being handled. Use
+	gfc_find_component to generate errors for non-existent or
+	private components.  Iteratively call self for derived type
+	extensions so that parent constructor is built.  If extension
+	and components left over, throw error.
+	(gfc_match_rvalue): Add extra arg to call to
+	gfc_match_structure_constructor.
+
+	* trans-array.c (gfc_conv_resolve_dependencies): If lhs and rhs
+	are the same symbol, aliassing does not matter.
+
+2008-07-29  Jan Hubicka  <jh@suse.cz>
+
+	* options.c (gfc_post_options): Do not set flag_no_inline.
+
+2008-07-29  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/36403
+	* trans-intrinsic.c (conv_generic_with_optional_char_arg):  New method
+	to append a string-length even if the string argument is missing, e.g.
+	for EOSHIFT.
+	(gfc_conv_intrinsic_function):  Call the new method for EOSHIFT, PACK
+	and RESHAPE.
+
 2008-07-28  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
 
 	* gfortran.h (try): Remove macro.  Replace try with gfc_try
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 9b1e5853b1d..8b9b8c0e868 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -367,7 +367,7 @@ match_data_constant (gfc_expr **result)
       return MATCH_ERROR;
     }
   else if (sym->attr.flavor == FL_DERIVED)
-    return gfc_match_structure_constructor (sym, result);
+    return gfc_match_structure_constructor (sym, result, false);
 
   /* Check to see if the value is an initialization array expression.  */
   if (sym->value->expr_type == EXPR_ARRAY)
@@ -6250,6 +6250,49 @@ syntax:
 }
 
 
+/* Check a derived type that is being extended.  */
+static gfc_symbol*
+check_extended_derived_type (char *name)
+{
+  gfc_symbol *extended;
+
+  if (gfc_find_symbol (name, gfc_current_ns, 1, &extended))
+    {
+      gfc_error ("Ambiguous symbol in TYPE definition at %C");
+      return NULL;
+    }
+
+  if (!extended)
+    {
+      gfc_error ("No such symbol in TYPE definition at %C");
+      return NULL;
+    }
+
+  if (extended->attr.flavor != FL_DERIVED)
+    {
+      gfc_error ("'%s' in EXTENDS expression at %C is not a "
+		 "derived type", name);
+      return NULL;
+    }
+
+  if (extended->attr.is_bind_c)
+    {
+      gfc_error ("'%s' cannot be extended at %C because it "
+		 "is BIND(C)", extended->name);
+      return NULL;
+    }
+
+  if (extended->attr.sequence)
+    {
+      gfc_error ("'%s' cannot be extended at %C because it "
+		 "is a SEQUENCE type", extended->name);
+      return NULL;
+    }
+
+  return extended;
+}
+
+
 /* Match the optional attribute specifiers for a type declaration.
    Return MATCH_ERROR if an error is encountered in one of the handled
    attributes (public, private, bind(c)), MATCH_NO if what's found is
@@ -6257,7 +6300,7 @@ syntax:
    checking on attribute conflicts needs to be done.  */
 
 match
-gfc_get_type_attr_spec (symbol_attribute *attr)
+gfc_get_type_attr_spec (symbol_attribute *attr, char *name)
 {
   /* See if the derived type is marked as private.  */
   if (gfc_match (" , private") == MATCH_YES)
@@ -6295,6 +6338,12 @@ gfc_get_type_attr_spec (symbol_attribute *attr)
 
       /* TODO: attr conflicts need to be checked, probably in symbol.c.  */
     }
+  else if (name && gfc_match(" , extends ( %n )", name) == MATCH_YES)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: derived type "
+	    "extended at %C") == FAILURE)
+	return MATCH_ERROR;
+    }
   else
     return MATCH_NO;
 
@@ -6311,8 +6360,10 @@ match
 gfc_match_derived_decl (void)
 {
   char name[GFC_MAX_SYMBOL_LEN + 1];
+  char parent[GFC_MAX_SYMBOL_LEN + 1];
   symbol_attribute attr;
   gfc_symbol *sym;
+  gfc_symbol *extended;
   match m;
   match is_type_attr_spec = MATCH_NO;
   bool seen_attr = false;
@@ -6320,17 +6371,27 @@ gfc_match_derived_decl (void)
   if (gfc_current_state () == COMP_DERIVED)
     return MATCH_NO;
 
+  name[0] = '\0';
+  parent[0] = '\0';
   gfc_clear_attr (&attr);
+  extended = NULL;
 
   do
     {
-      is_type_attr_spec = gfc_get_type_attr_spec (&attr);
+      is_type_attr_spec = gfc_get_type_attr_spec (&attr, parent);
       if (is_type_attr_spec == MATCH_ERROR)
 	return MATCH_ERROR;
       if (is_type_attr_spec == MATCH_YES)
 	seen_attr = true;
     } while (is_type_attr_spec == MATCH_YES);
 
+  /* Deal with derived type extensions.  */
+  if (parent[0])
+    extended = check_extended_derived_type (parent);
+
+  if (parent[0] && !extended)
+    return MATCH_ERROR;
+
   if (gfc_match (" ::") != MATCH_YES && seen_attr)
     {
       gfc_error ("Expected :: in TYPE definition at %C");
@@ -6383,10 +6444,34 @@ gfc_match_derived_decl (void)
   if (attr.is_bind_c != 0)
     sym->attr.is_bind_c = attr.is_bind_c;
 
+
   /* Construct the f2k_derived namespace if it is not yet there.  */
   if (!sym->f2k_derived)
     sym->f2k_derived = gfc_get_namespace (NULL, 0);
 
+  
+  if (extended && !sym->components)
+    {
+      gfc_component *p;
+      gfc_symtree *st;
+
+      /* Add the extended derived type as the first component.  */
+      gfc_add_component (sym, parent, &p);
+      sym->attr.extension = 1;
+      extended->refs++;
+      gfc_set_sym_referenced (extended);
+
+      p->ts.type = BT_DERIVED;
+      p->ts.derived = extended;
+      p->initializer = gfc_default_initializer (&p->ts);
+
+      /* Provide the links between the extended type and its extension.  */
+      if (!extended->f2k_derived)
+	extended->f2k_derived = gfc_get_namespace (NULL, 0);
+      st = gfc_new_symtree (&extended->f2k_derived->sym_root, sym->name);
+      st->n.sym = sym;
+    }
+
   gfc_new_block = sym;
 
   return MATCH_YES;
diff --git a/gcc/fortran/gfc-internals.texi b/gcc/fortran/gfc-internals.texi
index 330db81c59c..e73d3b59f9a 100644
--- a/gcc/fortran/gfc-internals.texi
+++ b/gcc/fortran/gfc-internals.texi
@@ -34,11 +34,10 @@
 Copyright @copyright{} @value{copyrights-gfortran} Free Software Foundation, Inc.
 
 Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.1 or
+under the terms of the GNU Free Documentation License, Version 1.2 or
 any later version published by the Free Software Foundation; with the
-Invariant Sections being ``GNU General Public License'' and ``Funding
-Free Software'', the Front-Cover
-texts being (a) (see below), and with the Back-Cover Texts being (b)
+Invariant Sections being ``Funding Free Software'', the Front-Cover
+Texts being (a) (see below), and with the Back-Cover Texts being (b)
 (see below).  A copy of the license is included in the section entitled
 ``GNU Free Documentation License''.
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 72cd871acc2..51192481326 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -638,6 +638,7 @@ typedef struct
   unsigned untyped:1;           /* No implicit type could be found.  */
 
   unsigned is_bind_c:1;		/* say if is bound to C */
+  unsigned extension:1;		/* extends a derived type */
 
   /* These flags are both in the typespec and attribute.  The attribute
      list is what gets read from/written to a module file.  The typespec
@@ -1016,9 +1017,6 @@ typedef struct gfc_symbol
 
   gfc_formal_arglist *formal;
   struct gfc_namespace *formal_ns;
-
-  /* The namespace containing type-associated procedure symbols.  */
-  /* TODO: Make this union with formal?  */
   struct gfc_namespace *f2k_derived;
 
   struct gfc_expr *value;	/* Parameter/Initializer value */
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index cf90ceda833..c79a70a407a 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -80,11 +80,10 @@
 Copyright @copyright{} @value{copyrights-gfortran} Free Software Foundation, Inc.
 
 Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.1 or
+under the terms of the GNU Free Documentation License, Version 1.2 or
 any later version published by the Free Software Foundation; with the
-Invariant Sections being ``GNU General Public License'' and ``Funding
-Free Software'', the Front-Cover
-texts being (a) (see below), and with the Back-Cover Texts being (b)
+Invariant Sections being ``Funding Free Software'', the Front-Cover
+Texts being (a) (see below), and with the Back-Cover Texts being (b)
 (see below).  A copy of the license is included in the section entitled
 ``GNU Free Documentation License''.
 
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index db336bfcd92..8337f74c522 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -7,10 +7,9 @@ For copying conditions, see the file gfortran.texi.
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.2 or
 any later version published by the Free Software Foundation; with the
-Invariant Sections being ``GNU General Public License'' and ``Funding
-Free Software'', the Front-Cover texts being (a) (see below), and with
-the Back-Cover Texts being (b) (see below).  A copy of the license is
-included in the gfdl(7) man page.
+Invariant Sections being ``Funding Free Software'', the Front-Cover
+Texts being (a) (see below), and with the Back-Cover Texts being (b)
+(see below).  A copy of the license is included in the gfdl(7) man page.
 
 
 Some basic guidelines for editing this document:
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index f633187a01c..b2370d4de0e 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -5,16 +5,15 @@
 
 @ignore
 @c man begin COPYRIGHT
-Copyright @copyright{} 2004, 2005, 2006, 2007
+Copyright @copyright{} 2004, 2005, 2006, 2007, 2008
 Free Software Foundation, Inc.
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.2 or
 any later version published by the Free Software Foundation; with the
-Invariant Sections being ``GNU General Public License'' and ``Funding
-Free Software'', the Front-Cover texts being (a) (see below), and with
-the Back-Cover Texts being (b) (see below).  A copy of the license is
-included in the gfdl(7) man page.
+Invariant Sections being ``Funding Free Software'', the Front-Cover
+Texts being (a) (see below), and with the Back-Cover Texts being (b)
+(see below).  A copy of the license is included in the gfdl(7) man page.
 
 (a) The FSF's Front-Cover Text is:
 
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index cc51072dff4..9c9d206822c 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -182,10 +182,10 @@ gfc_try get_bind_c_idents (void);
 match gfc_match_bind_c_stmt (void);
 match gfc_match_suffix (gfc_symbol *, gfc_symbol **);
 match gfc_match_bind_c (gfc_symbol *, bool);
-match gfc_get_type_attr_spec (symbol_attribute *);
+match gfc_get_type_attr_spec (symbol_attribute *, char*);
 
 /* primary.c.  */
-match gfc_match_structure_constructor (gfc_symbol *, gfc_expr **);
+match gfc_match_structure_constructor (gfc_symbol *, gfc_expr **, bool);
 match gfc_match_variable (gfc_expr **, int);
 match gfc_match_equiv_variable (gfc_expr **);
 match gfc_match_actual_arglist (int, gfc_actual_arglist **);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index a418bb9d9a4..ed575f9574f 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1648,7 +1648,8 @@ typedef enum
   AB_ELEMENTAL, AB_PURE, AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT,
   AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP,
   AB_POINTER_COMP, AB_PRIVATE_COMP, AB_VALUE, AB_VOLATILE, AB_PROTECTED,
-  AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP
+  AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP,
+  AB_EXTENSION
 }
 ab_attribute;
 
@@ -1688,6 +1689,7 @@ static const mstring attr_bits[] =
     minit ("ZERO_COMP", AB_ZERO_COMP),
     minit ("PROTECTED", AB_PROTECTED),
     minit ("ABSTRACT", AB_ABSTRACT),
+    minit ("EXTENSION", AB_EXTENSION),
     minit (NULL, -1)
 };
 
@@ -1801,6 +1803,8 @@ mio_symbol_attribute (symbol_attribute *attr)
 	MIO_NAME (ab_attribute) (AB_PRIVATE_COMP, attr_bits);
       if (attr->zero_comp)
 	MIO_NAME (ab_attribute) (AB_ZERO_COMP, attr_bits);
+      if (attr->extension)
+	MIO_NAME (ab_attribute) (AB_EXTENSION, attr_bits);
 
       mio_rparen ();
 
@@ -1919,6 +1923,9 @@ mio_symbol_attribute (symbol_attribute *attr)
 	    case AB_ZERO_COMP:
 	      attr->zero_comp = 1;
 	      break;
+	    case AB_EXTENSION:
+	      attr->extension = 1;
+	      break;
 	    }
 	}
     }
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 1f05f35359f..7b7916d4603 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -294,10 +294,6 @@ gfc_post_options (const char **pfilename)
 	gfc_warning_now ("'-fd-lines-as-code' has no effect in free form");
     }
 
-  /* Use tree inlining.  */
-  if (!flag_no_inline)
-    flag_no_inline = 1;
-
   /* If -pedantic, warn about the use of GNU extensions.  */
   if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0)
     gfc_option.warn_std |= GFC_STD_GNU;
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 782f38e4425..dfea043d6e3 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1984,11 +1984,103 @@ gfc_free_structure_ctor_component (gfc_structure_ctor_component *comp)
   gfc_free_expr (comp->val);
 }
 
-match
-gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result)
+
+/* Translate the component list into the actual constructor by sorting it in
+   the order required; this also checks along the way that each and every
+   component actually has an initializer and handles default initializers
+   for components without explicit value given.  */
+static gfc_try
+build_actual_constructor (gfc_structure_ctor_component **comp_head,
+			  gfc_constructor **ctor_head, gfc_symbol *sym)
 {
-  gfc_structure_ctor_component *comp_head, *comp_tail;
   gfc_structure_ctor_component *comp_iter;
+  gfc_constructor *ctor_tail = NULL;
+  gfc_component *comp;
+
+  for (comp = sym->components; comp; comp = comp->next)
+    {
+      gfc_structure_ctor_component **next_ptr;
+      gfc_expr *value = NULL;
+
+      /* Try to find the initializer for the current component by name.  */
+      next_ptr = comp_head;
+      for (comp_iter = *comp_head; comp_iter; comp_iter = comp_iter->next)
+	{
+	  if (!strcmp (comp_iter->name, comp->name))
+	    break;
+	  next_ptr = &comp_iter->next;
+	}
+
+      /* If an extension, try building the parent derived type by building
+	 a value expression for the parent derived type and calling self.  */
+      if (!comp_iter && comp == sym->components && sym->attr.extension)
+	{
+	  value = gfc_get_expr ();
+	  value->expr_type = EXPR_STRUCTURE;
+	  value->value.constructor = NULL;
+	  value->ts = comp->ts;
+	  value->where = gfc_current_locus;
+
+	  if (build_actual_constructor (comp_head, &value->value.constructor,
+					comp->ts.derived) == FAILURE)
+	    {
+	      gfc_free_expr (value);
+	      return FAILURE;
+	    }
+	  *ctor_head = ctor_tail = gfc_get_constructor ();
+	  ctor_tail->expr = value;
+	  continue;
+	}
+
+      /* If it was not found, try the default initializer if there's any;
+	 otherwise, it's an error.  */
+      if (!comp_iter)
+	{
+	  if (comp->initializer)
+	    {
+	      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Structure"
+				  " constructor with missing optional arguments"
+				  " at %C") == FAILURE)
+		return FAILURE;
+	      value = gfc_copy_expr (comp->initializer);
+	    }
+	  else
+	    {
+	      gfc_error ("No initializer for component '%s' given in the"
+			 " structure constructor at %C!", comp->name);
+	      return FAILURE;
+	    }
+	}
+      else
+	value = comp_iter->val;
+
+      /* Add the value to the constructor chain built.  */
+      if (ctor_tail)
+	{
+	  ctor_tail->next = gfc_get_constructor ();
+	  ctor_tail = ctor_tail->next;
+	}
+      else
+	*ctor_head = ctor_tail = gfc_get_constructor ();
+      gcc_assert (value);
+      ctor_tail->expr = value;
+
+      /* Remove the entry from the component list.  We don't want the expression
+	 value to be free'd, so set it to NULL.  */
+      if (comp_iter)
+	{
+	  *next_ptr = comp_iter->next;
+	  comp_iter->val = NULL;
+	  gfc_free_structure_ctor_component (comp_iter);
+	}
+    }
+  return SUCCESS;
+}
+
+match
+gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result, bool parent)
+{
+  gfc_structure_ctor_component *comp_tail, *comp_head, *comp_iter;
   gfc_constructor *ctor_head, *ctor_tail;
   gfc_component *comp; /* Is set NULL when named component is first seen */
   gfc_expr *e;
@@ -1996,10 +2088,10 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result)
   match m;
   const char* last_name = NULL;
 
-  comp_head = comp_tail = NULL;
+  comp_tail = comp_head = NULL;
   ctor_head = ctor_tail = NULL;
 
-  if (gfc_match_char ('(') != MATCH_YES)
+  if (!parent && gfc_match_char ('(') != MATCH_YES)
     goto syntax;
 
   where = gfc_current_locus;
@@ -2047,7 +2139,7 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result)
 		  if (last_name)
 		    gfc_error ("Component initializer without name after"
 			       " component named %s at %C!", last_name);
-		  else
+		  else if (!parent)
 		    gfc_error ("Too many components in structure constructor at"
 			       " %C!");
 		  goto cleanup;
@@ -2057,39 +2149,20 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result)
 	      strncpy (comp_tail->name, comp->name, GFC_MAX_SYMBOL_LEN + 1);
 	    }
 
-	  /* Find the current component in the structure definition; this is
-	     needed to get its access attribute in the private check below.  */
+	  /* Find the current component in the structure definition and check its
+	     access is not private.  */
 	  if (comp)
-	    this_comp = comp;
+	    this_comp = gfc_find_component (sym, comp->name);
 	  else
 	    {
-	      for (comp = sym->components; comp; comp = comp->next)
-		if (!strcmp (comp->name, comp_tail->name))
-		  {
-		    this_comp = comp;
-		    break;
-		  }
+	      this_comp = gfc_find_component (sym, (const char *)comp_tail->name);
 	      comp = NULL; /* Reset needed!  */
-
-	      /* Here we can check if a component name is given which does not
-		 correspond to any component of the defined structure.  */
-	      if (!this_comp)
-		{
-		  gfc_error ("Component '%s' in structure constructor at %C"
-			     " does not correspond to any component in the"
-			     " constructed structure!", comp_tail->name);
-		  goto cleanup;
-		}
 	    }
-	  gcc_assert (this_comp);
 
-	  /* Check the current component's access status.  */
-	  if (sym->attr.use_assoc && this_comp->access == ACCESS_PRIVATE)
-	    {
-	      gfc_error ("Component '%s' is PRIVATE in structure constructor"
-			 " at %C!", comp_tail->name);
-	      goto cleanup;
-	    }
+	  /* Here we can check if a component name is given which does not
+	     correspond to any component of the defined structure.  */
+	  if (!this_comp)
+	    goto cleanup;
 
 	  /* Check if this component is already given a value.  */
 	  for (comp_iter = comp_head; comp_iter != comp_tail; 
@@ -2111,89 +2184,56 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result)
 	  if (m == MATCH_ERROR)
 	    goto cleanup;
 
-	  if (comp)
-	    comp = comp->next;
-	}
-      while (gfc_match_char (',') == MATCH_YES);
+	  /* If not explicitly a parent constructor, gather up the components
+	     and build one.  */
+	  if (comp && comp == sym->components
+		&& sym->attr.extension
+		&& (comp_tail->val->ts.type != BT_DERIVED
+		      ||
+		    comp_tail->val->ts.derived != this_comp->ts.derived))
+	    {
+	      gfc_current_locus = where;
+	      gfc_free_expr (comp_tail->val);
 
-      if (gfc_match_char (')') != MATCH_YES)
-	goto syntax;
-	
-      /* If there were components given and all components are private, error
-	 out at this place.  */
-      if (sym->attr.use_assoc && sym->component_access == ACCESS_PRIVATE)
-	{
-	  gfc_error ("All components of '%s' are PRIVATE in structure"
-		     " constructor at %C", sym->name);
-	  goto cleanup;
-	}
-    }
+	      m = gfc_match_structure_constructor (comp->ts.derived, 
+						   &comp_tail->val, true);
+	      if (m == MATCH_NO)
+		goto syntax;
+	      if (m == MATCH_ERROR)
+		goto cleanup;
+	    }
 
-  /* Translate the component list into the actual constructor by sorting it in
-     the order required; this also checks along the way that each and every
-     component actually has an initializer and handles default initializers
-     for components without explicit value given.  */
-  for (comp = sym->components; comp; comp = comp->next)
-    {
-      gfc_structure_ctor_component **next_ptr;
-      gfc_expr *value = NULL;
+ 	  if (comp)
+	    comp = comp->next;
 
-      /* Try to find the initializer for the current component by name.  */
-      next_ptr = &comp_head;
-      for (comp_iter = comp_head; comp_iter; comp_iter = comp_iter->next)
-	{
-	  if (!strcmp (comp_iter->name, comp->name))
+	  if (parent && !comp)
 	    break;
-	  next_ptr = &comp_iter->next;
-	}
-
-      /* If it was not found, try the default initializer if there's any;
-	 otherwise, it's an error.  */
-      if (!comp_iter)
-	{
-	  if (comp->initializer)
-	    {
-	      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Structure"
-				  " constructor with missing optional arguments"
-				  " at %C") == FAILURE)
-		goto cleanup;
-	      value = gfc_copy_expr (comp->initializer);
-	    }
-	  else
-	    {
-	      gfc_error ("No initializer for component '%s' given in the"
-			 " structure constructor at %C!", comp->name);
-	      goto cleanup;
-	    }
 	}
-      else
-	value = comp_iter->val;
 
-      /* Add the value to the constructor chain built.  */
-      if (ctor_tail)
-	{
-	  ctor_tail->next = gfc_get_constructor ();
-	  ctor_tail = ctor_tail->next;
-	}
-      else
-	ctor_head = ctor_tail = gfc_get_constructor ();
-      gcc_assert (value);
-      ctor_tail->expr = value;
+      while (gfc_match_char (',') == MATCH_YES);
 
-      /* Remove the entry from the component list.  We don't want the expression
-	 value to be free'd, so set it to NULL.  */
-      if (comp_iter)
-	{
-	  *next_ptr = comp_iter->next;
-	  comp_iter->val = NULL;
-	  gfc_free_structure_ctor_component (comp_iter);
-	}
+      if (!parent && gfc_match_char (')') != MATCH_YES)
+	goto syntax;
     }
 
+  if (build_actual_constructor (&comp_head, &ctor_head, sym) == FAILURE)
+    goto cleanup;
+
   /* No component should be left, as this should have caused an error in the
      loop constructing the component-list (name that does not correspond to any
      component in the structure definition).  */
-  gcc_assert (!comp_head);
+  if (comp_head && sym->attr.extension)
+    {
+      for (comp_iter = comp_head; comp_iter; comp_iter = comp_iter->next)
+	{
+	  gfc_error ("component '%s' at %L has already been set by a "
+		     "parent derived type constructor", comp_iter->name,
+		     &comp_iter->where);
+	}
+      goto cleanup;
+    }
+  else
+    gcc_assert (!comp_head);
 
   e = gfc_get_expr ();
 
@@ -2396,7 +2436,7 @@ gfc_match_rvalue (gfc_expr **result)
       if (sym == NULL)
 	m = MATCH_ERROR;
       else
-	m = gfc_match_structure_constructor (sym, &e);
+	m = gfc_match_structure_constructor (sym, &e, false);
       break;
 
     /* If we're here, then the name is known to be the name of a
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 58c54f4d42b..d4cbd0b6684 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1701,6 +1701,14 @@ gfc_add_component (gfc_symbol *sym, const char *name,
       tail = p;
     }
 
+  if (sym->attr.extension
+	&& gfc_find_component (sym->components->ts.derived, name))
+    {
+      gfc_error ("Component '%s' at %C already in the parent type "
+		 "at %L", name, &sym->components->ts.derived->declared_at);
+      return FAILURE;
+    }
+
   /* Allocate a new component.  */
   p = gfc_get_component ();
 
@@ -1830,17 +1838,36 @@ gfc_find_component (gfc_symbol *sym, const char *name)
     if (strcmp (p->name, name) == 0)
       break;
 
+  if (p == NULL
+	&& sym->attr.extension
+	&& sym->components->ts.type == BT_DERIVED)
+    {
+      p = gfc_find_component (sym->components->ts.derived, name);
+      /* Do not overwrite the error.  */
+      if (p == NULL)
+	return p;
+    }
+
   if (p == NULL)
     gfc_error ("'%s' at %C is not a member of the '%s' structure",
 	       name, sym->name);
-  else
+
+  else if (sym->attr.use_assoc)
     {
-      if (sym->attr.use_assoc && (sym->component_access == ACCESS_PRIVATE
-				  || p->access == ACCESS_PRIVATE))
+      if (p->access == ACCESS_PRIVATE)
 	{
 	  gfc_error ("Component '%s' at %C is a PRIVATE component of '%s'",
 		     name, sym->name);
-	  p = NULL;
+	  return NULL;
+	}
+	
+      /* If there were components given and all components are private, error
+	 out at this place.  */
+      if (p->access != ACCESS_PUBLIC && sym->component_access == ACCESS_PRIVATE)
+	{
+	  gfc_error ("All components of '%s' are PRIVATE in structure"
+		     " constructor at %C", sym->name);
+	  return NULL;
 	}
     }
 
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index fe6b63de90b..6c6845daf4e 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3257,14 +3257,16 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
       if (ss->type != GFC_SS_SECTION)
 	continue;
 
-      if (gfc_could_be_alias (dest, ss)
-	    || gfc_are_equivalenced_arrays (dest->expr, ss->expr))
+      if (dest->expr->symtree->n.sym != ss->expr->symtree->n.sym)
 	{
-	  nDepend = 1;
-	  break;
+	  if (gfc_could_be_alias (dest, ss)
+		|| gfc_are_equivalenced_arrays (dest->expr, ss->expr))
+	    {
+	      nDepend = 1;
+	      break;
+	    }
 	}
-
-      if (dest->expr->symtree->n.sym == ss->expr->symtree->n.sym)
+      else
 	{
 	  lref = dest->expr->ref;
 	  rref = ss->expr->ref;
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 05ee3902e34..94b912f6d4c 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1,6 +1,6 @@
 /* Expression translation
-   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software
-   Foundation, Inc.
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+   Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
    and Steven Bosscher <s.bosscher@student.tudelft.nl>
 
@@ -395,6 +395,40 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
 }
 
 
+/* This function deals with component references to components of the
+   parent type for derived type extensons.  */
+static void
+conv_parent_component_references (gfc_se * se, gfc_ref * ref)
+{
+  gfc_component *c;
+  gfc_component *cmp;
+  gfc_symbol *dt;
+  gfc_ref parent;
+
+  dt = ref->u.c.sym;
+  c = ref->u.c.component;
+
+  /* Build a gfc_ref to recursively call gfc_conv_component_ref.  */
+  parent.type = REF_COMPONENT;
+  parent.next = NULL;
+  parent.u.c.sym = dt;
+  parent.u.c.component = dt->components;
+
+  if (dt->attr.extension && dt->components)
+    {
+      /* Return if the component is not in the parent type.  */
+      for (cmp = dt->components->next; cmp; cmp = cmp->next)
+	if (strcmp (c->name, cmp->name) == 0)
+	  return;
+	
+      /* Otherwise build the reference and call self.  */
+      gfc_conv_component_ref (se, &parent);
+      parent.u.c.sym = dt->components->ts.derived;
+      parent.u.c.component = c;
+      conv_parent_component_references (se, &parent);
+    }
+}
+
 /* Return the contents of a variable. Also handles reference/pointer
    variables (all Fortran pointer references are implicit).  */
 
@@ -561,6 +595,9 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 	  break;
 
 	case REF_COMPONENT:
+	  if (ref->u.c.sym->attr.extension)
+	    conv_parent_component_references (se, ref);
+
 	  gfc_conv_component_ref (se, ref);
 	  break;
 
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index a56f4c1fabb..bbb129dbdcd 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2652,6 +2652,64 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
   se->expr = fold_build3 (COND_EXPR, type, tmp, args[0], rrot);
 }
 
+
+/* Process an intrinsic with unspecified argument-types that has an optional
+   argument (which could be of type character), e.g. EOSHIFT.  For those, we
+   need to append the string length of the optional argument if it is not
+   present and the type is really character.
+   primary specifies the position (starting at 1) of the non-optional argument
+   specifying the type and optional gives the position of the optional
+   argument in the arglist.  */
+
+static void
+conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr,
+				     unsigned primary, unsigned optional)
+{
+  gfc_actual_arglist* prim_arg;
+  gfc_actual_arglist* opt_arg;
+  unsigned cur_pos;
+  gfc_actual_arglist* arg;
+  gfc_symbol* sym;
+  tree append_args;
+
+  /* Find the two arguments given as position.  */
+  cur_pos = 0;
+  prim_arg = NULL;
+  opt_arg = NULL;
+  for (arg = expr->value.function.actual; arg; arg = arg->next)
+    {
+      ++cur_pos;
+
+      if (cur_pos == primary)
+	prim_arg = arg;
+      if (cur_pos == optional)
+	opt_arg = arg;
+
+      if (cur_pos >= primary && cur_pos >= optional)
+	break;
+    }
+  gcc_assert (prim_arg);
+  gcc_assert (prim_arg->expr);
+  gcc_assert (opt_arg);
+
+  /* If we do have type CHARACTER and the optional argument is really absent,
+     append a dummy 0 as string length.  */
+  append_args = NULL_TREE;
+  if (prim_arg->expr->ts.type == BT_CHARACTER && !opt_arg->expr)
+    {
+      tree dummy;
+
+      dummy = build_int_cst (gfc_charlen_type_node, 0);
+      append_args = gfc_chainon_list (append_args, dummy);
+    }
+
+  /* Build the call itself.  */
+  sym = gfc_get_symbol_for_expr (expr);
+  gfc_conv_function_call (se, sym, expr->value.function.actual, append_args);
+  gfc_free (sym);
+}
+
+
 /* The length of a character string.  */
 static void
 gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr)
@@ -4128,7 +4186,22 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
 	{
 	  if (lib == 1)
 	    se->ignore_optional = 1;
-	  gfc_conv_intrinsic_funcall (se, expr);
+
+	  switch (expr->value.function.isym->id)
+	    {
+	    case GFC_ISYM_EOSHIFT:
+	    case GFC_ISYM_PACK:
+	    case GFC_ISYM_RESHAPE:
+	      /* For all of those the first argument specifies the type and the
+		 third is optional.  */
+	      conv_generic_with_optional_char_arg (se, expr, 1, 3);
+	      break;
+
+	    default:
+	      gfc_conv_intrinsic_funcall (se, expr);
+	      break;
+	    }
+
 	  return;
 	}
     }
@@ -4606,6 +4679,14 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_funcall (se, expr);
       break;
 
+    case GFC_ISYM_EOSHIFT:
+    case GFC_ISYM_PACK:
+    case GFC_ISYM_RESHAPE:
+      /* For those, expr->rank should always be >0 and thus the if above the
+	 switch should have matched.  */
+      gcc_unreachable ();
+      break;
+
     default:
       gfc_conv_intrinsic_lib_function (se, expr);
       break;
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index e304d1687bf..6d63ecdf742 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -1,6 +1,6 @@
 /* IO Code translation/library interface
-   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software
-   Foundation, Inc.
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+   Free Software Foundation, Inc.
    Contributed by Paul Brook
 
 This file is part of GCC.