From patchwork Sat Feb 17 04:02:27 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jerry D X-Patchwork-Id: 85917 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 51000385734F for ; Sat, 17 Feb 2024 04:02:59 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-pl1-x631.google.com (mail-pl1-x631.google.com [IPv6:2607:f8b0:4864:20::631]) by sourceware.org (Postfix) with ESMTPS id F0B22385772D; Sat, 17 Feb 2024 04:02:29 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org F0B22385772D Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmail.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org F0B22385772D Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2607:f8b0:4864:20::631 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1708142552; cv=none; b=A4i2TMUOWgAkbibMAd2X7GP3o/F6iZigKZmwwkDBAaDlzrTd30TQtmaHwIedFN4WUjkUr6keD03v/mUXHdU3b4+rBzdC1nOzW3bkoPvSPT0JXNdnY6VNAFuh8MH3rtkNrZtM6dsB3wHGEy0tR85p5k2SYAp6J5wNgSknmbPWvTc= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1708142552; c=relaxed/simple; bh=J44ZO4v0WeE2M4hU9gnVefVEf/Qru4QlzRUc71S+fh0=; h=DKIM-Signature:Message-ID:Date:MIME-Version:To:From:Subject; b=AHrn+7C8VzOUDafW0EiiWsVT94yoO1W3BNnmM5zcbF1M56F6VybbEcMHQU2dO0aMH76/eMKVHpmnBqQroAQZobNbdmmOONUBJD/D3GqilpVp21eykmr0mS4gwb1qwmw2x3LU+WeBPD9fwZSP86Tj1QG5OKiqqDGIe2J3aTnPbVs= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-pl1-x631.google.com with SMTP id d9443c01a7336-1dbcb562b02so302085ad.0; Fri, 16 Feb 2024 20:02:29 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1708142548; x=1708747348; darn=gcc.gnu.org; h=autocrypt:subject:from:cc:to:content-language:user-agent :mime-version:date:message-id:from:to:cc:subject:date:message-id :reply-to; bh=PCb6WrE7S5/UhhAthx48yx0jn7QM/o+kO6mp7RfR3d0=; b=YEuiQ0tbtqmCOO/oGNoNYjnI5hb9Q32zFvHPiL3hlZj/UKGEx6iAYwUGYwZU1yinzS qnbIwRV0jnGzfpGLoTDrM0LMfnmYPl8183k2IbWcOgHWR//o1p2owpxJ0ZWd9LVV9RL+ dh53zr07R47I2Moq2j+tErzDbdSxvGepFTKI+jdNxHiyILiptkjuB2kiYjz4N6Mc6DSm EZadBiUOohdQYhN8I843DtyyPch0zrAQ7jWV24nOJEiM7Zh873+CbnRuhOnm0/GK//Bt VyqiitCsV+LNBv6/1dQKGnD/GGLrNuHiyjbjcqYp2hG7ARiTb9ut+F2Audy3PSfXPGLQ yrxg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1708142549; x=1708747349; h=autocrypt:subject:from:cc:to:content-language:user-agent :mime-version:date:message-id:x-gm-message-state:from:to:cc:subject :date:message-id:reply-to; bh=PCb6WrE7S5/UhhAthx48yx0jn7QM/o+kO6mp7RfR3d0=; b=vahNQbwnR9ALcWh5tgGli08W3ureoYYbPlCHEpEXxBk1WH3K/9U6RgZfLwaKUlGi5p 5ymr8hqAKTedY0ki1Q+rE0Nuew2dwyzaRvdn/+HJVdxDVobQP/+Ct3eYOfPNnoD71+zs 3xrTRDhg6ZXq25SE70rsfT1lqXKpev6STiV77j9etovsauQCqFmC9lzm9ZglVMA5dk0g 6IAcXYz/PKLrDN44u3ngT5PnUuhI4fiVMVWC3EnivyOQBj8nLHB1Pi653hLFy5hu+B0d I34JEovNBb8VzzTzKtzOk9UxasmMpCuZmx4AUEGwS3gFMdN93y+9uQ6MS7x2W0ECpSJD y+Qg== X-Gm-Message-State: AOJu0Yxaf4ns6p5Hn9f+kU3dLqTfg5sMUy1/Lf4wp6ASoUPsYSj5YqfL sH3kE3vXghxNzL07ZThNbn9nGzB6ShlBCOnyz2YwCNkj4Kb9i83cznBjqpDX X-Google-Smtp-Source: AGHT+IFHPi3/JmKIMMC7yJgdxL1bwjxItewC1hzZBZcEAUxfCeQGk33EbqeZ/fpQRLbNnJ6Q3HENjw== X-Received: by 2002:a17:902:c14b:b0:1db:92e1:2e55 with SMTP id 11-20020a170902c14b00b001db92e12e55mr4296728plj.2.1708142548420; Fri, 16 Feb 2024 20:02:28 -0800 (PST) Received: from [192.168.1.20] ([50.37.177.113]) by smtp.gmail.com with ESMTPSA id p11-20020a1709026b8b00b001d78a08e8e7sm547429plk.250.2024.02.16.20.02.27 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Fri, 16 Feb 2024 20:02:28 -0800 (PST) Message-ID: <10cb5f16-9cba-4f3f-875c-3e55d0c89525@gmail.com> Date: Fri, 16 Feb 2024 20:02:27 -0800 MIME-Version: 1.0 User-Agent: Mozilla Thunderbird Content-Language: en-US To: gfortran Cc: gcc-patches From: Jerry D Subject: [patch, libgfortran] Bug 105473 - semicolon allowed when list-directed read integer with decimal='point' Autocrypt: addr=jvdelisle2@gmail.com; keydata= xjMEY5TlkxYJKwYBBAHaRw8BAQdAyrkRDhmJhSTTlV/50gJLlvliU6/Lm5C9ViKV8T9y1GnN HkplcnJ5IEQgPGp2ZGVsaXNsZTJAZ21haWwuY29tPsKJBBMWCAAxFiEEOFR0TS0390uh8dRV uWXAJaWpwWoFAmOU5ZMCGwMECwkIBwUVCAkKCwUWAgMBAAAKCRC5ZcAlpanBalsJAP4wdCiH 2Of9oZv1QWgZ/AVdbWFM3Fv47/WZQHOXfoZ9HgD6AkXrKeJ+6usST7PEaDJjptaViT1fLiYY V/6XaOKSsgLOOARjlOWTEgorBgEEAZdVAQUBAQdAdA7PczYnl07vnOT9oP/wvvMDd4HP09Zl g3LzwXQJWT8DAQgHwngEGBYIACAWIQQ4VHRNLTf3S6Hx1FW5ZcAlpanBagUCY5TlkwIbDAAK CRC5ZcAlpanBasF/AQCa5WjlsVpLsEiggZyT18MOJNAdeRd7wkGDUrwedHrvawD/cE1H+/Ms L1ZwvQiLfGdx8crigQqWTQyos4kH8Wx82wc= X-Spam-Status: No, score=-8.0 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Hello, I posted the attached patch in bugzilla some time ago. This includes a new test case. The patch adds additional checks in key places to catch eroneous use of semicolons Regression tested on x86_64, OK for trunk and later backport to 13? Jerry diff --git a/gcc/testsuite/gfortran.dg/pr105473.f90 b/gcc/testsuite/gfortran.dg/pr105473.f90 new file mode 100644 index 00000000000..b309217540d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr105473.f90 @@ -0,0 +1,46 @@ +! { dg-do run } +! PR libgfortran/105473 + implicit none + integer n,m,ios + real r + complex z + character(40):: testinput + n = 999; m = 777; r=1.2345 + z = cmplx(0.0,0.0) + +! Check that semi-colon is not allowed as separator with decimal=point. + ios=0 + testinput = '1;17;3.14159' + read(testinput,*,decimal='point',iostat=ios) n, m, r + if (ios /= 5010) print *, "stop 1" + +! Check that comma is not allowed as a separator with decimal=comma. + ios=0 + testinput = '1,17,3,14159' + read(testinput,*,decimal='comma',iostat=ios) n, m, r + if (ios /= 5010) print *, "stop 2" + +! Check a good read. + ios=99 + testinput = '1;17;3,14159' + read(testinput,*,decimal='comma',iostat=ios) n, m, r + if (ios /= 0) print *, "stop 3" + +! Check that comma is not allowed as a separator with decimal=comma. + ios=99; z = cmplx(0.0,0.0) + testinput = '1,17, (3,14159, 1,7182)' + read(testinput,*,decimal='comma', iostat=ios) n, m, z + if (ios /= 5010) stop 4 + +! Check that semi-colon is not allowed as separator with decimal=point. + ios=99; z = cmplx(0.0,0.0) + testinput = '1,17; (3.14159; 1.7182)' + read(testinput,*,decimal='point', iostat=ios) n, m, z + if (ios /= 5010) stop 5 + +! Check a good read. + ios=99;z = cmplx(0.0,0.0) + testinput = '1;17; (3,14159; 1,7182)' + read(testinput,*,decimal='comma', iostat=ios) n, m, z + if (ios /= 0) stop 6 +end program diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 0b7884fdda7..d2316ad6fe2 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -53,7 +53,6 @@ typedef unsigned char uchar; #define CASE_SEPARATORS /* Fall through. */ \ case ' ': case ',': case '/': case '\n': \ case '\t': case '\r': case ';' - /* This macro assumes that we're operating on a variable. */ #define is_separator(c) (c == '/' || c == ',' || c == '\n' || c == ' ' \ @@ -475,11 +474,23 @@ eat_separator (st_parameter_dt *dtp) case ',': if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) { + generate_error (&dtp->common, LIBERROR_READ_VALUE, + "Comma not allowed as separator with DECIMAL='comma'"); unget_char (dtp, c); break; } - /* Fall through. */ + dtp->u.p.comma_flag = 1; + eat_spaces (dtp); + break; + case ';': + if (dtp->u.p.current_unit->decimal_status == DECIMAL_POINT) + { + generate_error (&dtp->common, LIBERROR_READ_VALUE, + "Semicolon not allowed as separator with DECIMAL='point'"); + unget_char (dtp, c); + break; + } dtp->u.p.comma_flag = 1; eat_spaces (dtp); break; @@ -1326,8 +1337,13 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length) { if ((c = next_char (dtp)) == EOF) goto bad; - if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) - c = '.'; + if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + { + if (c == '.') + goto bad; + if (c == ',') + c = '.'; + } switch (c) { CASE_DIGITS: @@ -1636,8 +1652,18 @@ read_real (st_parameter_dt *dtp, void *dest, int length) seen_dp = 0; c = next_char (dtp); - if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) - c = '.'; + if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + { + if (c == '.') + goto bad_real; + if (c == ',') + c = '.'; + } + if (dtp->u.p.current_unit->decimal_status == DECIMAL_POINT) + { + if (c == ';') + goto bad_real; + } switch (c) { CASE_DIGITS: @@ -1677,8 +1703,13 @@ read_real (st_parameter_dt *dtp, void *dest, int length) for (;;) { c = next_char (dtp); - if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) - c = '.'; + if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + { + if (c == '.') + goto bad_real; + if (c == ',') + c = '.'; + } switch (c) { CASE_DIGITS: @@ -1718,7 +1749,7 @@ read_real (st_parameter_dt *dtp, void *dest, int length) CASE_SEPARATORS: case EOF: - if (c != '\n' && c != ',' && c != '\r' && c != ';') + if (c != '\n' && c != ',' && c != ';' && c != '\r') unget_char (dtp, c); goto done; diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c index e2d2f8be806..7a9e341d7d8 100644 --- a/libgfortran/io/read.c +++ b/libgfortran/io/read.c @@ -1062,8 +1062,17 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length) case ',': if (dtp->u.p.current_unit->decimal_status != DECIMAL_COMMA) goto bad_float; - /* Fall through. */ + if (seen_dp) + goto bad_float; + if (!seen_int_digit) + *(out++) = '0'; + *(out++) = '.'; + seen_dp = 1; + break; + case '.': + if (dtp->u.p.current_unit->decimal_status != DECIMAL_POINT) + goto bad_float; if (seen_dp) goto bad_float; if (!seen_int_digit)