From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wr1-x433.google.com (mail-wr1-x433.google.com [IPv6:2a00:1450:4864:20::433]) by sourceware.org (Postfix) with ESMTPS id 7A64A382FC85 for ; Mon, 21 Nov 2022 10:14:22 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 7A64A382FC85 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: by mail-wr1-x433.google.com with SMTP id s5so1882658wru.1 for ; Mon, 21 Nov 2022 02:14:22 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=JOc/Z42Pev+Q9wUag5n5+4fRWCvJI+Jw0ces6nGkl/U=; b=e3SQsTartbS0TPtFTiYIXKr7Dgjw009jcGROED0DTnMAxxoq0XKzx99FOSuILVPmkH p0IJDUTAa8wQsSeTJkjJV+DIrPe/dR9f0JpKMLIQBFn8EjLlC+BMRB/kX+xcy/k96vCC M+xi3zUerE6t6rzBMvIcqdtPFDhYjLnPP/8DDGli13V+opi4l11B6Mwr9KeTqECR/r/b HhCrZCanokbcGk5o8GvFZC1zbWszkk2jjjtVfQ5mPF37D61BK5lhMgN1cGjOgFCFCQbQ 6yeqC+kpr9zVPeiHJEycplr95ACtwbXpuvNfaxz8oo6j4WI618ke+rHRMgXubD+t9Xvl TKxA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=JOc/Z42Pev+Q9wUag5n5+4fRWCvJI+Jw0ces6nGkl/U=; b=BnQMgRGS7m+Nq0qRIohmIpdDeKVYDiTyy6S9x+COkrQCgE6X+aiuHBQptjl0ileJCo i17TkVPV+IGYMzzn09iTqFi9mGU0ipLR6NvtdvN5jfA7Kc5mtiVPROwN3Pe8TV5+tDw9 Ihqkw/cwdC+Kmy3SRjtb4kx7CGta8itBLckXSU1bBRzM5LgE4EcmbEa9kD1hQQAdq4E3 nyPLjCUnngLi5Q6PNOiMBhXBVZfUf/cTAs2fJo8GCmxVTYcXuEWecUn0YWRVBN2YxsXg KHD5XPrR1uFmWud+3TdOo+b3xvZtp4sQscCiD6FmBhR2HnmGVlLsdmiFRIQlfLpE9Upg FRLg== X-Gm-Message-State: ANoB5pnfx2Vsez7tEdIJlkj2kaKyXxmcdJKM64AJCbDokSUHAhyXE9US Jjp79g5ILO5LQEz1XYS5NREgfvaKmi5XsQ== X-Google-Smtp-Source: AA0mqf7mGXKJznzMq5lB3TJUzMJPr1jVCh0UJUcGNeHvzyaOOyDyHpUDmlx6YlofPivfuL9SHU2L+Q== X-Received: by 2002:adf:f8d1:0:b0:241:d3e4:6517 with SMTP id f17-20020adff8d1000000b00241d3e46517mr2938844wrq.380.1669025661250; Mon, 21 Nov 2022 02:14:21 -0800 (PST) Received: from localhost.localdomain (static-176-191-105-132.ftth.abo.bbox.fr. [176.191.105.132]) by smtp.gmail.com with ESMTPSA id n38-20020a05600c182600b003c6deb5c1edsm12632491wmp.45.2022.11.21.02.14.20 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 21 Nov 2022 02:14:20 -0800 (PST) From: =?UTF-8?q?Marc=20Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Steve Baird Subject: [COMMITTED] ada: Ada 2022 Image attribute bugs Date: Mon, 21 Nov 2022 11:14:18 +0100 Message-Id: <20221121101418.259338-1-poulhies@adacore.com> X-Mailer: git-send-email 2.34.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-13.0 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,GIT_PATCH_0,KAM_ASCII_DIVIDERS,RCVD_IN_DNSWL_NONE,SPF_HELO_NONE,SPF_PASS,TXREP,T_FILL_THIS_FORM_SHORT autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: From: Steve Baird Two issues. First, the two procedures Ada.Strings.Text_Buffers.Output_Mapping.[Wide_]Wide_Put each correctly call Encode, but that call was missing from the corresponding Put procedure. Second, if a record type contains an array-valued Data component as well as both a Max_Length and Current_Length component, then the slice Data (Current_Length + 1 .. Max_Length) should usually be treated like uninitialized data. It should not participate in things like equality comparisons. In particular, it should not participate in 'Image results. To accomplish this, such a type usually ought to have a Put_Image aspect specification. This Put_Image aspect specification was missing for the three Super_String types declared in the Ada.Strings.[Wide_[Wide_]]Superbounded packages. gcc/ada/ * libgnat/a-sttebu.adb (Put): Add missing call to Encode. * libgnat/a-strsup.ads: Declare new Put_Image procedure and add Put_Image aspect specification for type Super_String. * libgnat/a-strsup.adb (Put_Image): New procedure. * libgnat/a-stwisu.ads: Declare new Put_Image procedure and add Put_Image aspect specification for type Super_String. * libgnat/a-stwisu.adb (Put_Image): New procedure. * libgnat/a-stzsup.ads: Declare new Put_Image procedure and add Put_Image aspect specification for type Super_String. * libgnat/a-stzsup.adb (Put_Image): New procedure. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/a-strsup.adb | 11 +++++++++++ gcc/ada/libgnat/a-strsup.ads | 8 +++++++- gcc/ada/libgnat/a-sttebu.adb | 3 ++- gcc/ada/libgnat/a-stwisu.adb | 11 +++++++++++ gcc/ada/libgnat/a-stwisu.ads | 8 +++++++- gcc/ada/libgnat/a-stzsup.adb | 11 +++++++++++ gcc/ada/libgnat/a-stzsup.ads | 8 +++++++- 7 files changed, 56 insertions(+), 4 deletions(-) diff --git a/gcc/ada/libgnat/a-strsup.adb b/gcc/ada/libgnat/a-strsup.adb index 831a18e1e19..0210b45c4c7 100644 --- a/gcc/ada/libgnat/a-strsup.adb +++ b/gcc/ada/libgnat/a-strsup.adb @@ -303,6 +303,17 @@ package body Ada.Strings.Superbounded with SPARK_Mode is return Left <= Super_To_String (Right); end Less_Or_Equal; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; + Source : Super_String) is + begin + String'Put_Image (S, Super_To_String (Source)); + end Put_Image; + ---------------------- -- Set_Super_String -- ---------------------- diff --git a/gcc/ada/libgnat/a-strsup.ads b/gcc/ada/libgnat/a-strsup.ads index 416fa7bb06a..600f097c2bf 100644 --- a/gcc/ada/libgnat/a-strsup.ads +++ b/gcc/ada/libgnat/a-strsup.ads @@ -49,6 +49,7 @@ pragma Assertion_Policy (Pre => Ignore, with Ada.Strings.Maps; use type Ada.Strings.Maps.Character_Mapping_Function; with Ada.Strings.Search; +with Ada.Strings.Text_Buffers; package Ada.Strings.Superbounded with SPARK_Mode is pragma Preelaborate; @@ -69,7 +70,8 @@ package Ada.Strings.Superbounded with SPARK_Mode is with Predicate => Current_Length <= Max_Length - and then Data (1 .. Current_Length)'Initialized; + and then Data (1 .. Current_Length)'Initialized, + Put_Image => Put_Image; -- The subprograms defined for Super_String are similar to those -- defined for Bounded_String, except that they have different names, so @@ -2695,6 +2697,10 @@ package Ada.Strings.Superbounded with SPARK_Mode is - (Item.Max_Length - K) mod Super_Length (Item)))), Global => null; + procedure Put_Image + (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; + Source : Super_String); + private -- Pragma Inline declarations diff --git a/gcc/ada/libgnat/a-sttebu.adb b/gcc/ada/libgnat/a-sttebu.adb index d992fee9f04..acca2923443 100644 --- a/gcc/ada/libgnat/a-sttebu.adb +++ b/gcc/ada/libgnat/a-sttebu.adb @@ -29,6 +29,7 @@ -- -- ------------------------------------------------------------------------------ +with Ada.Strings.UTF_Encoding.Strings; with Ada.Strings.UTF_Encoding.Wide_Strings; with Ada.Strings.UTF_Encoding.Wide_Wide_Strings; @@ -59,7 +60,7 @@ package body Ada.Strings.Text_Buffers is procedure Put (Buffer : in out Buffer_Type; Item : String) is begin - Put_UTF_8 (Buffer, Item); + Put_UTF_8 (Buffer, UTF_Encoding.Strings.Encode (Item)); end Put; procedure Wide_Put (Buffer : in out Buffer_Type; Item : Wide_String) is diff --git a/gcc/ada/libgnat/a-stwisu.adb b/gcc/ada/libgnat/a-stwisu.adb index d325676edf9..cf27ca9f190 100644 --- a/gcc/ada/libgnat/a-stwisu.adb +++ b/gcc/ada/libgnat/a-stwisu.adb @@ -297,6 +297,17 @@ package body Ada.Strings.Wide_Superbounded is return Left <= Right.Data (1 .. Right.Current_Length); end Less_Or_Equal; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; + Source : Super_String) is + begin + Wide_String'Put_Image (S, Super_To_String (Source)); + end Put_Image; + ---------------------- -- Set_Super_String -- ---------------------- diff --git a/gcc/ada/libgnat/a-stwisu.ads b/gcc/ada/libgnat/a-stwisu.ads index c22c2a23850..7437cbda224 100644 --- a/gcc/ada/libgnat/a-stwisu.ads +++ b/gcc/ada/libgnat/a-stwisu.ads @@ -37,6 +37,7 @@ -- Strings.Wide_Bounded.Generic_Bounded_Length use this type with -- an appropriate discriminant value set. +with Ada.Strings.Text_Buffers; with Ada.Strings.Wide_Maps; package Ada.Strings.Wide_Superbounded is @@ -54,7 +55,8 @@ package Ada.Strings.Wide_Superbounded is -- no longer necessary, because we now special-case this type in the -- compiler, so "=" composes properly for descendants of this type. -- Leaving it out is more efficient. - end record; + end record + with Put_Image => Put_Image; -- The subprograms defined for Super_String are similar to those defined -- for Bounded_Wide_String, except that they have different names, so that @@ -477,6 +479,10 @@ package Ada.Strings.Wide_Superbounded is Item : Super_String; Drop : Truncation := Error) return Super_String; + procedure Put_Image + (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; + Source : Super_String); + private -- Pragma Inline declarations diff --git a/gcc/ada/libgnat/a-stzsup.adb b/gcc/ada/libgnat/a-stzsup.adb index 6153bbe392f..a4fa9968bef 100644 --- a/gcc/ada/libgnat/a-stzsup.adb +++ b/gcc/ada/libgnat/a-stzsup.adb @@ -297,6 +297,17 @@ package body Ada.Strings.Wide_Wide_Superbounded is return Left <= Right.Data (1 .. Right.Current_Length); end Less_Or_Equal; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; + Source : Super_String) is + begin + Wide_Wide_String'Put_Image (S, Super_To_String (Source)); + end Put_Image; + ---------------------- -- Set_Super_String -- ---------------------- diff --git a/gcc/ada/libgnat/a-stzsup.ads b/gcc/ada/libgnat/a-stzsup.ads index 148b972b30d..b50d21ad6ae 100644 --- a/gcc/ada/libgnat/a-stzsup.ads +++ b/gcc/ada/libgnat/a-stzsup.ads @@ -37,6 +37,7 @@ -- Strings.Wide_Wide_Bounded.Generic_Bounded_Length use this type with -- an appropriate discriminant value set. +with Ada.Strings.Text_Buffers; with Ada.Strings.Wide_Wide_Maps; package Ada.Strings.Wide_Wide_Superbounded is @@ -55,7 +56,8 @@ package Ada.Strings.Wide_Wide_Superbounded is -- no longer necessary, because we now special-case this type in the -- compiler, so "=" composes properly for descendants of this type. -- Leaving it out is more efficient. - end record; + end record + with Put_Image => Put_Image; -- The subprograms defined for Super_String are similar to those defined -- for Bounded_Wide_Wide_String, except that they have different names, so @@ -486,6 +488,10 @@ package Ada.Strings.Wide_Wide_Superbounded is Item : Super_String; Drop : Truncation := Error) return Super_String; + procedure Put_Image + (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; + Source : Super_String); + private -- Pragma Inline declarations -- 2.34.1