public inbox for gcc-bugs@sourceware.org
help / color / mirror / Atom feed
* [Bug fortran/26393]  New: "CONTAIN"-ed + assumed character length + "WRITE" -> ICE at trans-decl.c:849?
@ 2006-02-21 12:22 P dot Schaffnit at access dot rwth-aachen dot de
  2006-02-21 12:24 ` [Bug fortran/26393] " P dot Schaffnit at access dot rwth-aachen dot de
                   ` (7 more replies)
  0 siblings, 8 replies; 9+ messages in thread
From: P dot Schaffnit at access dot rwth-aachen dot de @ 2006-02-21 12:22 UTC (permalink / raw)
  To: gcc-bugs

Hi!

I have some severly twisted code (..): a "CONTAIN"-ed routine with assumed
character length arguments writing out a string (...) which causes an ICE. The
bad news, is that a "barebones" similar thing compiles (and runs) fine, so I
had to reduce it by trial and error, 8-( ... Whatever, don't look for much
sense here, but I believe that to be still valid (and lf95 would seem to
agree!).

Philippe

PS: what I get (and how I do it):
gfortran -c -g -pedantic-errors -Wall Sources.f90
Sources.f90: In function 'outdiffkoeff':
Sources.f90:85: internal compiler error: in gfc_get_symbol_decl, at
fortran/trans-decl.c:849
Please submit a full bug report,
with preprocessed source if appropriate.
See <URL:http://gcc.gnu.org/bugs.html> for instructions.

PPS: the "sources":
!
      MODULE MODULE_DIMENSION
!
      INTEGER, PARAMETER :: Sng = 4
      INTEGER, PARAMETER :: Dbl = 8
      INTEGER, PARAMETER :: Dft = Sng
!
      INTEGER, PARAMETER :: Length_File_Name = 1000
!
      END MODULE MODULE_DIMENSION
!
!
      MODULE MODULE_CONC
!
      USE MODULE_DIMENSION, ONLY: Length_File_Name, Dft, Sng, Dbl
!
      INTEGER, PARAMETER :: Weight = 1, Atom = 2
      INTEGER, PARAMETER :: Atom_to_Weight = 1, Weight_to_Atom = 2
!
      INTEGER, SAVE                               :: anzKomponenten = 0
      INTEGER, SAVE                               :: concTyp
      INTEGER, SAVE, ALLOCATABLE, DIMENSION(:,:,:):: diffZeiger
!
      REAL ( KIND = Dft ), SAVE, ALLOCATABLE  :: diffKoefKonst(:)
      REAL ( KIND = Dft ), SAVE, ALLOCATABLE  :: diffKoefAkt(:)
!
      END MODULE MODULE_CONC
!
!
      MODULE MODULE_THERMOCALC
!
      USE MODULE_DIMENSION, ONLY: Dft, Sng, Dbl
!
      CHARACTER ( LEN = 2 ), SAVE, ALLOCATABLE  ::   kompNameTQ(:)
      CHARACTER ( LEN = 12 ), SAVE, ALLOCATABLE ::   phaseNameTQ(:)
!
      LOGICAL, SAVE, ALLOCATABLE ::   usePhaseTQ(:)
      LOGICAL, SAVE, ALLOCATABLE ::   diff_Coeff_Inter(:,:)
!
      INTEGER, SAVE, ALLOCATABLE ::   cNr(:)
      INTEGER, SAVE, ALLOCATABLE ::   pNr(:)
!
      REAL ( KIND = Dft ), SAVE, ALLOCATABLE ::                        &
     &                                         diff_Coeff_Cond_Conc(:,:)
      REAL ( KIND = Dft ), SAVE, ALLOCATABLE ::                        &
     &                                         diff_Coeff_Cond_Temp(:)
!
      INTERFACE
          FUNCTION solveCConvert ( Flag_Conversion, Composition )
              USE MODULE_CONC, ONLY: anzKomponenten
              USE MODULE_DIMENSION, ONLY: Dft
              IMPLICIT NONE
              INTEGER, INTENT ( IN )         ::   Flag_Conversion
              REAL ( KIND = Dft ),                                     &
     &                        INTENT ( IN )  ::   Composition          &
     &                                            ( 1 : anzKomponenten )
              REAL ( KIND = Dft )            ::   solveCConvert        &
     &                                            ( 1 : anzKomponenten )
          END FUNCTION solveCConvert
      END INTERFACE
!
      END MODULE MODULE_THERMOCALC
!
!
      SUBROUTINE outDiffKoeff ( phase )
!
      USE MODULE_CONC
      USE MODULE_DIMENSION
      USE MODULE_THERMOCALC
!
      IMPLICIT   NONE
!
      LOGICAL, PARAMETER  ::   thermocalc = .TRUE.
!
      INTEGER                           ::   IO_Stat
      INTEGER                           ::   phase, k
!
      REAL ( KIND = Dft ), PARAMETER    ::   R = 8.31441
      REAL ( KIND = Dft )               ::   buffer_conc               &
     &                                            ( 1 : anzKomponenten )
!
      CHARACTER ( LEN = 250 )           ::   String
!
      WRITE ( String, FMT = * ) diff_Coeff_Cond_Temp(phase)
      CALL CTN_Write_String ( TRIM(String), "(A)" )
          IF ( ( ( thermocalc ) .AND. ( concTyp .EQ. Weight ) ) ) THEN
            buffer_conc = solveCConvert ( Atom_to_Weight, &
     &                diff_Coeff_Cond_Conc(phase,:) ) * 1E2
          ELSE
            buffer_conc = diff_Coeff_Cond_Conc(phase,:) * 1E2
          ENDIF
          DO k = 1, anzKomponenten
              WRITE ( UNIT = String, FMT = "(ES12.4)" ) buffer_conc(k)
              CALL CTN_Write_String ( TRIM(String), "(A)" )
          ENDDO
!
      CONTAINS
!
        SUBROUTINE CTN_Write_String ( String, Fmt )
!
          CHARACTER ( LEN = * ), INTENT ( IN )    ::   String, Fmt
!
          WRITE ( UNIT = 12, FMT = TRIM(Fmt), IOSTAT = IO_Stat )       &
     &                                                      TRIM(String)
          IF ( IO_Stat .NE. 0 ) THEN
            CALL toolStop
          ENDIF
!
        END SUBROUTINE CTN_Write_String
!
      END SUBROUTINE outDiffKoeff
!

PPPS: I'm using 4.2.0 20060221 (experimental)


-- 
           Summary: "CONTAIN"-ed + assumed character length + "WRITE" -> ICE
                    at trans-decl.c:849?
           Product: gcc
           Version: 4.2.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
        AssignedTo: unassigned at gcc dot gnu dot org
        ReportedBy: P dot Schaffnit at access dot rwth-aachen dot de


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=26393


^ permalink raw reply	[flat|nested] 9+ messages in thread

* [Bug fortran/26393] "CONTAIN"-ed + assumed character length + "WRITE" -> ICE at trans-decl.c:849?
  2006-02-21 12:22 [Bug fortran/26393] New: "CONTAIN"-ed + assumed character length + "WRITE" -> ICE at trans-decl.c:849? P dot Schaffnit at access dot rwth-aachen dot de
@ 2006-02-21 12:24 ` P dot Schaffnit at access dot rwth-aachen dot de
  2006-02-21 12:59 ` [Bug fortran/26393] ICE with function returning variable lenght array pinskia at gcc dot gnu dot org
                   ` (6 subsequent siblings)
  7 siblings, 0 replies; 9+ messages in thread
From: P dot Schaffnit at access dot rwth-aachen dot de @ 2006-02-21 12:24 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #1 from P dot Schaffnit at access dot rwth-aachen dot de  2006-02-21 12:24 -------

Oops!

I forgot to mention that the whole thing occurs under Linux (see hereafter).

Philippe

PS: uname -a:
Linux pinguin7 2.6.5-7.104-bigsmp #1 SMP Wed Jul 28 16:42:13 UTC 2004 i686 i686
i386 GNU/Linux


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=26393


^ permalink raw reply	[flat|nested] 9+ messages in thread

* [Bug fortran/26393] ICE with function returning variable lenght array
  2006-02-21 12:22 [Bug fortran/26393] New: "CONTAIN"-ed + assumed character length + "WRITE" -> ICE at trans-decl.c:849? P dot Schaffnit at access dot rwth-aachen dot de
  2006-02-21 12:24 ` [Bug fortran/26393] " P dot Schaffnit at access dot rwth-aachen dot de
@ 2006-02-21 12:59 ` pinskia at gcc dot gnu dot org
  2006-02-27 16:18 ` paul dot richard dot thomas at cea dot fr
                   ` (5 subsequent siblings)
  7 siblings, 0 replies; 9+ messages in thread
From: pinskia at gcc dot gnu dot org @ 2006-02-21 12:59 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #2 from pinskia at gcc dot gnu dot org  2006-02-21 12:58 -------
Reduced testcase:
    MODULE MODULE_CONC
      INTEGER, SAVE                               :: anzKomponenten = 0
    END MODULE MODULE_CONC
    MODULE MODULE_THERMOCALC
      INTERFACE
          FUNCTION solveCConvert (  )
              USE MODULE_CONC, ONLY: anzKomponenten
              REAL         ::   solveCConvert      ( 1 : anzKomponenten )
          END FUNCTION solveCConvert
      END INTERFACE
    END MODULE MODULE_THERMOCALC
    SUBROUTINE outDiffKoeff (  )
      USE MODULE_CONC
      USE MODULE_THERMOCALC
      REAL        ::   buffer_conc   ( 1 : anzKomponenten )
      buffer_conc = solveCConvert (  ) * 1E2
    END SUBROUTINE outDiffKoeff

----

This has nothing to do with assumed write or characters.


-- 

pinskia at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|UNCONFIRMED                 |NEW
     Ever Confirmed|0                           |1
           Keywords|                            |ice-on-valid-code
   Last reconfirmed|0000-00-00 00:00:00         |2006-02-21 12:58:56
               date|                            |
            Summary|"CONTAIN"-ed + assumed      |ICE with function returning
                   |character length + "WRITE" -|variable lenght array
                   |> ICE at trans-decl.c:849?  |


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=26393


^ permalink raw reply	[flat|nested] 9+ messages in thread

* [Bug fortran/26393] ICE with function returning variable lenght array
  2006-02-21 12:22 [Bug fortran/26393] New: "CONTAIN"-ed + assumed character length + "WRITE" -> ICE at trans-decl.c:849? P dot Schaffnit at access dot rwth-aachen dot de
  2006-02-21 12:24 ` [Bug fortran/26393] " P dot Schaffnit at access dot rwth-aachen dot de
  2006-02-21 12:59 ` [Bug fortran/26393] ICE with function returning variable lenght array pinskia at gcc dot gnu dot org
@ 2006-02-27 16:18 ` paul dot richard dot thomas at cea dot fr
  2006-02-27 23:40 ` patchapp at dberlin dot org
                   ` (4 subsequent siblings)
  7 siblings, 0 replies; 9+ messages in thread
From: paul dot richard dot thomas at cea dot fr @ 2006-02-27 16:18 UTC (permalink / raw)
  To: gcc-bugs

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 2200 bytes --]



------- Comment #3 from paul dot richard dot thomas at cea dot fr  2006-02-27 16:10 -------
I have a fix that I will post tonight but it appears below anyway.

Paul

Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c    (r&#9500;®vision 111471)
+++ gcc/fortran/trans-decl.c    (copie de travail)
@@ -846,7 +846,8 @@
   tree length = NULL_TREE;
   int byref;

-  gcc_assert (sym->attr.referenced);
+  gcc_assert (sym->attr.referenced
+               || sym->ns->proc_name->attr.if_source == IFSRC_IFBODY);

   if (sym->ns && sym->ns->proc_name->attr.function)
     byref = gfc_return_by_reference (sym->ns->proc_name);

and the testcase

! { dg-do run }
! Tests the fix for PR26393, in which an ICE would occur in trans-decl.c
! (gfc_get_symbol_decl) because anzKomponenten is not referenced in the
! interface for solveCConvert. The solution was to assert that the symbol
! is either referenced or in an interface body.
!
! Based on the testcase in the PR.
!
  MODULE MODULE_CONC
    INTEGER, SAVE :: anzKomponenten = 2
  END MODULE MODULE_CONC

  MODULE MODULE_THERMOCALC
    INTERFACE
      FUNCTION solveCConvert ()
        USE MODULE_CONC, ONLY: anzKomponenten
        REAL :: solveCConvert(1:anzKomponenten)
        END FUNCTION solveCConvert
    END INTERFACE
  END MODULE MODULE_THERMOCALC

  SUBROUTINE outDiffKoeff
    USE MODULE_CONC
    USE MODULE_THERMOCALC
    REAL :: buffer_conc(1:anzKomponenten)
    buffer_conc = solveCConvert ()
    if (any(buffer_conc .ne. (/(real(i), i = 1, anzKomponenten)/))) &
          call abort ()
  END SUBROUTINE outDiffKoeff

  program missing_ref
    USE MODULE_CONC
    call outDiffKoeff
! Now set anzKomponenten to a value that would cause a segfault if
! buffer_conc and solveCConvert did not have the correct allocation
! of memory.
    anzKomponenten = 5000
    call outDiffKoeff
  end program missing_ref

  FUNCTION solveCConvert ()
    USE MODULE_CONC, ONLY: anzKomponenten
    REAL :: solveCConvert(1:anzKomponenten)
    solveCConvert = (/(real(i), i = 1, anzKomponenten)/)
  END FUNCTION solveCConvert



-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=26393


^ permalink raw reply	[flat|nested] 9+ messages in thread

* [Bug fortran/26393] ICE with function returning variable lenght array
  2006-02-21 12:22 [Bug fortran/26393] New: "CONTAIN"-ed + assumed character length + "WRITE" -> ICE at trans-decl.c:849? P dot Schaffnit at access dot rwth-aachen dot de
                   ` (2 preceding siblings ...)
  2006-02-27 16:18 ` paul dot richard dot thomas at cea dot fr
@ 2006-02-27 23:40 ` patchapp at dberlin dot org
  2006-03-01 22:24 ` pault at gcc dot gnu dot org
                   ` (3 subsequent siblings)
  7 siblings, 0 replies; 9+ messages in thread
From: patchapp at dberlin dot org @ 2006-02-27 23:40 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #4 from patchapp at dberlin dot org  2006-02-27 23:30 -------
Subject: Bug number PR26393

A patch for this bug has been added to the patch tracker.
The mailing list url for the patch is
http://gcc.gnu.org/ml/gcc-patches/2006-02/msg02025.html


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=26393


^ permalink raw reply	[flat|nested] 9+ messages in thread

* [Bug fortran/26393] ICE with function returning variable lenght array
  2006-02-21 12:22 [Bug fortran/26393] New: "CONTAIN"-ed + assumed character length + "WRITE" -> ICE at trans-decl.c:849? P dot Schaffnit at access dot rwth-aachen dot de
                   ` (3 preceding siblings ...)
  2006-02-27 23:40 ` patchapp at dberlin dot org
@ 2006-03-01 22:24 ` pault at gcc dot gnu dot org
  2006-03-01 23:24 ` pault at gcc dot gnu dot org
                   ` (2 subsequent siblings)
  7 siblings, 0 replies; 9+ messages in thread
From: pault at gcc dot gnu dot org @ 2006-03-01 22:24 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #5 from pault at gcc dot gnu dot org  2006-03-01 22:24 -------
Subject: Bug 26393

Author: pault
Date: Wed Mar  1 22:24:19 2006
New Revision: 111616

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=111616
Log:
2006-03-01  Paul Thomas  <pault@gcc.gnu.org>

        * iresolve.c (gfc_resolve_dot_product):  Remove any difference in
        treatment of logical types.
        * trans-intrinsic.c (gfc_conv_intrinsic_dot_product):  New function. 

        PR fortran/26393
        * trans-decl.c (gfc_get_symbol_decl): Extend condition that symbols
        must be referenced to include unreferenced symbols in an interface
        body. 

        PR fortran/20938
        * trans-array.c (gfc_conv_resolve_dependencies): Add call to
        gfc_are_equivalenced_arrays.
        * symbol.c (gfc_free_equiv_infos, gfc_free_equiv_lists): New
        functions. (gfc_free_namespace): Call them.
        * trans-common.c (copy_equiv_list_to_ns): New function.
        (add_equivalences): Call it.
        * gfortran.h: Add equiv_lists to gfc_namespace and define
        gfc_equiv_list and gfc_equiv_info.
        * dependency.c (gfc_are_equivalenced_arrays): New function.
        (gfc_check_dependency): Call it.
        * dependency.h: Prototype for gfc_are_equivalenced_arrays.

2006-03-01  Paul Thomas  <pault@gcc.gnu.org>

        * gfortran.dg/logical_dot_product.f90: New test. 

        PR fortran/26393
        * gfortran.dg/used_interface_ref.f90: New test.

        PR fortran/20938
        * gfortran.dg/dependency_2.f90: New test.
        * gfortran.fortran-torture/execute/where17.f90: New test.
        * gfortran.fortran-torture/execute/where18.f90: New test.
        * gfortran.fortran-torture/execute/where19.f90: New test.
        * gfortran.fortran-torture/execute/where20.f90: New test.


Added:
    trunk/gcc/testsuite/gfortran.dg/dependency_2.f90
    trunk/gcc/testsuite/gfortran.dg/logical_dot_product.f90
    trunk/gcc/testsuite/gfortran.dg/used_interface_ref.f90
    trunk/gcc/testsuite/gfortran.fortran-torture/execute/where17.f90
    trunk/gcc/testsuite/gfortran.fortran-torture/execute/where18.f90
    trunk/gcc/testsuite/gfortran.fortran-torture/execute/where19.f90
    trunk/gcc/testsuite/gfortran.fortran-torture/execute/where20.f90
Modified:
    trunk/MAINTAINERS
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/dependency.c
    trunk/gcc/fortran/dependency.h
    trunk/gcc/fortran/gfortran.h
    trunk/gcc/fortran/iresolve.c
    trunk/gcc/fortran/symbol.c
    trunk/gcc/fortran/trans-array.c
    trunk/gcc/fortran/trans-common.c
    trunk/gcc/fortran/trans-decl.c
    trunk/gcc/fortran/trans-intrinsic.c
    trunk/gcc/testsuite/ChangeLog


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=26393


^ permalink raw reply	[flat|nested] 9+ messages in thread

* [Bug fortran/26393] ICE with function returning variable lenght array
  2006-02-21 12:22 [Bug fortran/26393] New: "CONTAIN"-ed + assumed character length + "WRITE" -> ICE at trans-decl.c:849? P dot Schaffnit at access dot rwth-aachen dot de
                   ` (4 preceding siblings ...)
  2006-03-01 22:24 ` pault at gcc dot gnu dot org
@ 2006-03-01 23:24 ` pault at gcc dot gnu dot org
  2006-03-07  0:07 ` pault at gcc dot gnu dot org
  2006-03-07  2:25 ` pinskia at gcc dot gnu dot org
  7 siblings, 0 replies; 9+ messages in thread
From: pault at gcc dot gnu dot org @ 2006-03-01 23:24 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #6 from pault at gcc dot gnu dot org  2006-03-01 23:24 -------
Fixed on mainline.  Patch ready for 4.1 to reopen.

Paul


-- 

pault at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|NEW                         |RESOLVED
         Resolution|                            |FIXED


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=26393


^ permalink raw reply	[flat|nested] 9+ messages in thread

* [Bug fortran/26393] ICE with function returning variable lenght array
  2006-02-21 12:22 [Bug fortran/26393] New: "CONTAIN"-ed + assumed character length + "WRITE" -> ICE at trans-decl.c:849? P dot Schaffnit at access dot rwth-aachen dot de
                   ` (5 preceding siblings ...)
  2006-03-01 23:24 ` pault at gcc dot gnu dot org
@ 2006-03-07  0:07 ` pault at gcc dot gnu dot org
  2006-03-07  2:25 ` pinskia at gcc dot gnu dot org
  7 siblings, 0 replies; 9+ messages in thread
From: pault at gcc dot gnu dot org @ 2006-03-07  0:07 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #7 from pault at gcc dot gnu dot org  2006-03-07 00:06 -------
Subject: Bug 26393

Author: pault
Date: Tue Mar  7 00:06:37 2006
New Revision: 111796

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=111796
Log:
2006-03-07  Paul Thomas  <pault@gcc.gnu.org>

        PR fortran/26107
        * resolve.c (resolve_function): Add name after test for pureness.

        * iresolve.c (gfc_resolve_dot_product):  Remove any difference in
        treatment of logical types.
        * trans-intrinsic.c (gfc_conv_intrinsic_dot_product):  New function. 

        PR fortran/26393
        * trans-decl.c (gfc_get_symbol_decl): Extend condition that symbols
        must be referenced to include unreferenced symbols in an interface
        body. 

        PR fortran/20938
        * trans-array.c (gfc_conv_resolve_dependencies): Add call to
        gfc_are_equivalenced_arrays.
        * symbol.c (gfc_free_equiv_infos, gfc_free_equiv_lists): New
        functions. (gfc_free_namespace): Call them.
        * trans-common.c (copy_equiv_list_to_ns): New function.
        (add_equivalences): Call it.
        * gfortran.h: Add equiv_lists to gfc_namespace and define
        gfc_equiv_list and gfc_equiv_info.
        * dependency.c (gfc_are_equivalenced_arrays): New function.
        (gfc_check_dependency): Call it.
        * dependency.h: Prototype for gfc_are_equivalenced_arrays.

        PR fortran/24519
        * dependency.c (gfc_is_same_range): Correct typo.
        (gfc_check_section_vs_section): Call gfc_is_same_range.

        PR fortran/25395
        * trans-common.c (add_equivalences): Add a new flag that is set when
        an equivalence is seen that prevents more from being reset until the
        start of a new traversal of the list, thus ensuring completion of
        all the equivalences.

        PR fortran/25054
        * resolve.c (is_non_constant_shape_array): New function.
        (resolve_fl_variable): Remove code for the new function and call it.
        (resolve_fl_namelist): New function.  Add test for namelist array
        with non-constant shape, using is_non_constant_shape_array.
        (resolve_symbol): Remove code for resolve_fl_namelist and call it.

        PR fortran/25089
        * match.c (match_namelist): Increment the refs field of an accepted
        namelist object symbol.
        * resolve.c (resolve_fl_namelist): Test namelist objects for a conflict
        with contained or module procedures.

        PR fortran/24557
        * trans-expr.c (gfc_add_interface_mapping): Use the actual argument
        for character(*) arrays, rather than casting to the type and kind
        parameters of the formal argument.

2006-03-07  Paul Thomas  <pault@gcc.gnu.org>

        PR fortran/26107
        * resolve.c (resolve_function): Add name after test for pureness.

        * gfortran.dg/logical_dot_product.f90: New test. 

        PR fortran/26393
        * gfortran.dg/used_interface_ref.f90: New test.

        PR fortran/20938
        * gfortran.dg/dependency_2.f90: New test.
        * gfortran.fortran-torture/execute/where17.f90: New test.
        * gfortran.fortran-torture/execute/where18.f90: New test.
        * gfortran.fortran-torture/execute/where19.f90: New test.
        * gfortran.fortran-torture/execute/where20.f90: New test.

        PR fortran/24519
        * gfortran.dg/dependency_3.f90: New test.
        * gfortran.fortran-torture/execute/vect-3.f90: Remove two of the
        XFAILs.

        PR fortran/25395
        * gfortran.dg/equiv_6.f90: New test.

        PR fortran/25054
        * gfortran.dg/namelist_5.f90: New test.

        PR fortran/25089
        * gfortran.dg/namelist_4.f90: New test.

        PR fortran/24557
        * gfortran.dg/assumed_charlen_needed_1.f90: New test.

Added:
   
branches/gcc-4_1-branch/gcc/testsuite/gfortran.dg/assumed_charlen_needed_1.f90
    branches/gcc-4_1-branch/gcc/testsuite/gfortran.dg/dependency_2.f90
    branches/gcc-4_1-branch/gcc/testsuite/gfortran.dg/dependency_3.f90
    branches/gcc-4_1-branch/gcc/testsuite/gfortran.dg/equiv_6.f90
    branches/gcc-4_1-branch/gcc/testsuite/gfortran.dg/logical_dot_product.f90
    branches/gcc-4_1-branch/gcc/testsuite/gfortran.dg/namelist_4.f90
    branches/gcc-4_1-branch/gcc/testsuite/gfortran.dg/namelist_5.f90
    branches/gcc-4_1-branch/gcc/testsuite/gfortran.dg/pure_dummy_length_1.f90
    branches/gcc-4_1-branch/gcc/testsuite/gfortran.dg/used_interface_ref.f90
   
branches/gcc-4_1-branch/gcc/testsuite/gfortran.fortran-torture/execute/where17.f90
   
branches/gcc-4_1-branch/gcc/testsuite/gfortran.fortran-torture/execute/where18.f90
   
branches/gcc-4_1-branch/gcc/testsuite/gfortran.fortran-torture/execute/where19.f90
   
branches/gcc-4_1-branch/gcc/testsuite/gfortran.fortran-torture/execute/where20.f90
Modified:
    branches/gcc-4_1-branch/MAINTAINERS
    branches/gcc-4_1-branch/gcc/fortran/ChangeLog
    branches/gcc-4_1-branch/gcc/fortran/dependency.c
    branches/gcc-4_1-branch/gcc/fortran/dependency.h
    branches/gcc-4_1-branch/gcc/fortran/dump-parse-tree.c
    branches/gcc-4_1-branch/gcc/fortran/gfortran.h
    branches/gcc-4_1-branch/gcc/fortran/iresolve.c
    branches/gcc-4_1-branch/gcc/fortran/match.c
    branches/gcc-4_1-branch/gcc/fortran/resolve.c
    branches/gcc-4_1-branch/gcc/fortran/symbol.c
    branches/gcc-4_1-branch/gcc/fortran/trans-array.c
    branches/gcc-4_1-branch/gcc/fortran/trans-common.c
    branches/gcc-4_1-branch/gcc/fortran/trans-decl.c
    branches/gcc-4_1-branch/gcc/fortran/trans-expr.c
    branches/gcc-4_1-branch/gcc/fortran/trans-intrinsic.c
    branches/gcc-4_1-branch/gcc/testsuite/ChangeLog
    branches/gcc-4_1-branch/gcc/testsuite/gfortran.dg/vect/vect-3.f90


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=26393


^ permalink raw reply	[flat|nested] 9+ messages in thread

* [Bug fortran/26393] ICE with function returning variable lenght array
  2006-02-21 12:22 [Bug fortran/26393] New: "CONTAIN"-ed + assumed character length + "WRITE" -> ICE at trans-decl.c:849? P dot Schaffnit at access dot rwth-aachen dot de
                   ` (6 preceding siblings ...)
  2006-03-07  0:07 ` pault at gcc dot gnu dot org
@ 2006-03-07  2:25 ` pinskia at gcc dot gnu dot org
  7 siblings, 0 replies; 9+ messages in thread
From: pinskia at gcc dot gnu dot org @ 2006-03-07  2:25 UTC (permalink / raw)
  To: gcc-bugs



-- 

pinskia at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
   Target Milestone|---                         |4.1.1


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=26393


^ permalink raw reply	[flat|nested] 9+ messages in thread

end of thread, other threads:[~2006-03-07  2:25 UTC | newest]

Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2006-02-21 12:22 [Bug fortran/26393] New: "CONTAIN"-ed + assumed character length + "WRITE" -> ICE at trans-decl.c:849? P dot Schaffnit at access dot rwth-aachen dot de
2006-02-21 12:24 ` [Bug fortran/26393] " P dot Schaffnit at access dot rwth-aachen dot de
2006-02-21 12:59 ` [Bug fortran/26393] ICE with function returning variable lenght array pinskia at gcc dot gnu dot org
2006-02-27 16:18 ` paul dot richard dot thomas at cea dot fr
2006-02-27 23:40 ` patchapp at dberlin dot org
2006-03-01 22:24 ` pault at gcc dot gnu dot org
2006-03-01 23:24 ` pault at gcc dot gnu dot org
2006-03-07  0:07 ` pault at gcc dot gnu dot org
2006-03-07  2:25 ` pinskia at gcc dot gnu dot org

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).