PR fortran/14067
* data.c (create_character_intializer): Add warning message
for truncated string.
PR fortran/16943
* symbol.c : Include flags.h.
(gfc_add_type): If a procedure and types are the same do not
throw an error unless standard is less than gnu or pedantic.
PR fortran/20838
* parse.c (parse_do_block): Error if named block do construct
does not have a named enddo.
PR fortran/27655
* check.c (gfc_check_associated): Pick up EXPR_NULL for pointer
as well as target and put error return at end of function.
2006-06-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/14067
* gfortran.dg/data_char_1.f90: Add messages for truncated
strings.
PR fortran/16943
* gfortran.dg/func_decl_2.f90: New test.
PR fortran/20838
* gfortran.dg/do_2.f90: New test.
PR fortran/27655
* gfortran.dg/associated_3.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@114385
138bc75d-0d04-0410-961f-
82ee72b054a4
+2006-06-05 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/14067
+ * data.c (create_character_intializer): Add warning message
+ for truncated string.
+
+ PR fortran/16943
+ * symbol.c : Include flags.h.
+ (gfc_add_type): If a procedure and types are the same do not
+ throw an error unless standard is less than gnu or pedantic.
+
+ PR fortran/20838
+ * parse.c (parse_do_block): Error if named block do construct
+ does not have a named enddo.
+
+ PR fortran/27655
+ * check.c (gfc_check_associated): Pick up EXPR_NULL for pointer
+ as well as target and put error return at end of function.
+
2006-06-03 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* trans.c (gfc_msg_bounds, gfc_msg_fault, gfc_msg_wrong_return):
symbol_attribute attr;
int i;
try t;
+ locus *where;
+
+ where = &pointer->where;
if (pointer->expr_type == EXPR_VARIABLE)
attr = gfc_variable_attr (pointer, NULL);
else if (pointer->expr_type == EXPR_FUNCTION)
attr = pointer->symtree->n.sym->attr;
+ else if (pointer->expr_type == EXPR_NULL)
+ goto null_arg;
else
gcc_assert (0); /* Pointer must be a variable or a function. */
if (target == NULL)
return SUCCESS;
+ where = &target->where;
if (target->expr_type == EXPR_NULL)
- {
- gfc_error ("NULL pointer at %L is not permitted as actual argument "
- "of '%s' intrinsic function",
- &target->where, gfc_current_intrinsic);
- return FAILURE;
- }
+ goto null_arg;
if (target->expr_type == EXPR_VARIABLE)
attr = gfc_variable_attr (target, NULL);
}
}
return t;
+
+null_arg:
+
+ gfc_error ("NULL pointer at %L is not permitted as actual argument "
+ "of '%s' intrinsic function", where, gfc_current_intrinsic);
+ return FAILURE;
+
}
/* Copy the initial value. */
len = rvalue->value.character.length;
if (len > end - start)
- len = end - start;
+ {
+ len = end - start;
+ gfc_warning_now ("initialization string truncated to match variable "
+ "at %L", &rvalue->where);
+ }
+
memcpy (&dest[start], rvalue->value.character.string, len);
/* Pad with spaces. Substrings will already be blanked. */
break;
case ST_IMPLIED_ENDDO:
+ /* If the do-stmt of this DO construct has a do-construct-name,
+ the corresponding end-do must be an end-do-stmt (with a matching
+ name, but in that case we must have seen ST_ENDDO first).
+ We only complain about this in pedantic mode. */
+ if (gfc_current_block () != NULL)
+ gfc_error_now
+ ("named block DO at %L requires matching ENDDO name",
+ &gfc_current_block()->declared_at);
+
break;
default:
#include "config.h"
#include "system.h"
+#include "flags.h"
#include "gfortran.h"
#include "parse.h"
if (sym->ts.type != BT_UNKNOWN)
{
- gfc_error ("Symbol '%s' at %L already has basic type of %s", sym->name,
- where, gfc_basic_typename (sym->ts.type));
- return FAILURE;
+ const char *msg = "Symbol '%s' at %L already has basic type of %s";
+ if (!(sym->ts.type == ts->type
+ && (sym->attr.flavor == FL_PROCEDURE || sym->attr.result))
+ || gfc_notification_std (GFC_STD_GNU) == ERROR
+ || pedantic)
+ {
+ gfc_error (msg, sym->name, where, gfc_basic_typename (sym->ts.type));
+ return FAILURE;
+ }
+ else if (gfc_notify_std (GFC_STD_GNU, msg, sym->name, where,
+ gfc_basic_typename (sym->ts.type)) == FAILURE)
+ return FAILURE;
}
flavor = sym->attr.flavor;
+2006-06-05 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/14067
+ * gfortran.dg/data_char_1.f90: Add messages for truncated
+ strings.
+
+ PR fortran/16943
+ * gfortran.dg/func_decl_2.f90: New test.
+
+ PR fortran/20838
+ * gfortran.dg/do_2.f90: New test.
+
+ PR fortran/27655
+ * gfortran.dg/associated_3.f90: New test.
+
2006-06-04 Mark Mitchell <mark@codesourcery.com>
PR c++/27819
--- /dev/null
+! { dg-do compile }
+! Test for fix of PR27655
+!
+!Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+ integer, pointer :: i
+ print *, associated(NULL(),i) ! { dg-error "not permitted as actual argument" }
+ print *, associated(i,NULL()) ! { dg-error "not permitted as actual argument" }
+end
! { dg-do run }
! Test character variables in data statements
-! Also substrings of cahracter variables.
+! Also substrings of character variables.
! PR14976 PR16228
program data_char_1
character(len=5) :: a(2)
character(len=5) :: b(2)
- data a /'Hellow', 'orld'/
- data b(:)(1:4), b(1)(5:5), b(2)(5:5) /'abcdefg', 'hi', 'j', 'k'/
+ data a /'Hellow', 'orld'/ ! { dg-warning "string truncated" }
+ data b(:)(1:4), b(1)(5:5), b(2)(5:5) &
+ /'abcdefg', 'hi', 'j', 'k'/ ! { dg-warning "string truncated" }
if ((a(1) .ne. 'Hello') .or. (a(2) .ne. 'orld ')) call abort
if ((b(1) .ne. 'abcdj') .or. (b(2) .ne. 'hi k')) call abort
--- /dev/null
+! { dg-do compile }
+! Check the fix for PR20839, which concerned non-compliance with one of the
+! constraints for block-do-constructs (8.1.4.1.1):
+! Constraint: If the do-stmt of a block-do-construct is identified by a
+! do-construct-name, the corresponding end-do shall be an end-do-stmt
+! specifying the same do-construct-name. (Tests a & b)
+! If the do-stmt of a block-do-construct is not identified by a
+! do-construct-name, the corresponding end-do shall not specify a
+! do-construct-name. (Tests c & d)
+! Constraint: If the do-stmt is a nonlabel-do-stmt, the corresponding end-do
+! shall be an end-do-stmt.
+! Constraint: If the do-stmt is a label-do-stmt, the corresponding end-do shall
+! be identified with the same label.
+!
+! Test a - this was the PR
+ doi: DO 111 i=1,3 ! { dg-error "requires matching ENDDO name" }
+111 continue
+! Test b
+ doii: DO 112 ij=1,3
+112 enddo doij ! { dg-error "Expected label" }
+! Test c
+ DO 113 ik=1,3
+113 enddo doik ! { dg-error "Syntax error" }
+! Test d
+ DO il=1,3
+ enddo doil ! { dg-error "Syntax error" }
+! Test e
+ doj: DO 114 j=1,3
+ enddo doj ! { dg-error "doesn't match DO label" }
+
+! Correct block do constructs
+dok: DO 115 k=1,3
+ dokk: do kk=1,3
+ dokkk: DO
+ do kkkk=1,3
+ do
+ enddo
+ enddo
+ enddo dokkk
+ enddo dokk
+115 enddo dok
+! Correct non-block do constructs
+ do 117 l=1,3
+ do ll=1,3
+ do 116 lll=1,3
+116 continue
+ enddo
+117 enddo
+! These prevent an EOF error, arising from the previous errors.
+end do
+113 end do
+112 end do doii
+END
+
--- /dev/null
+! { dg-do compile }
+! Test fix for PR16943 in which the double typing of
+! N caused an error. This is a common extension to the
+! F95 standard, so the error is only thrown for -std=f95
+! or -pedantic.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+ program bug8
+ implicit none
+ stop " OK. "
+
+ contains
+
+ integer function bugf(M) result (N)
+ integer, intent (in) :: M
+ integer :: N ! { dg-warning "already has basic type of INTEGER" }
+ N = M
+ return
+ end function bugf
+ end program bug8
OSDN Git Service
