From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wr1-x42c.google.com (mail-wr1-x42c.google.com [IPv6:2a00:1450:4864:20::42c]) by sourceware.org (Postfix) with ESMTPS id AE6A83875DDC for ; Tue, 26 Sep 2023 11:46:39 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org AE6A83875DDC 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-x42c.google.com with SMTP id ffacd0b85a97d-3231df68584so4694699f8f.1 for ; Tue, 26 Sep 2023 04:46:39 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1695728798; x=1696333598; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=OMZUlCV+vqrf1m/Ah5zJ5DqiqoLyhTy4oBu8HCTreXg=; b=ZMUXzW8acMD9BDUPjfmC9sFT18osKuyQs6K2knGDc4aftEQYMbiTJHBrY1QxQBT09X 0bTOktDM5Zc9wQmBhVMXTgbvGYr34Srn8xQtUevJbyv/ZTPfA+qlXDWw6nkoP9IYiVXO xb0dylvYmeiJxcyINqlfNZD/swijawzQp/PqePkjAJxtiBeEnwOEM6UF4yqcQ5IrQBXE +RYNDUhsiz1SU41ATog480agAz0EZvirVwXaHKUTj3wdZ+Yr76JAZ4OykpwCv8g1TW0Q bjeaDyfLN0cQXDHEZIwmVJ3T0sjin8257nUOOp/24ScRHOlbHg7zw01UgCA/b5kF8Fri QP3w== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1695728798; x=1696333598; 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=OMZUlCV+vqrf1m/Ah5zJ5DqiqoLyhTy4oBu8HCTreXg=; b=DMlmQE6f/yXWxeHNkqeGuGhiYOZ938kuDJ0Z8/dPy0iS72JsHHLd9riWjGO0G80ajH 2K+dv86daN3WBoCn2iu8r+7NmiBovnRn0ebSmJyj530GS3en16I4d056qiYJB/OKYGYF IMw9vTUQV3dH8f/Qns2ILnB5qJu5mpZ9ZQjzK9z2QLF8rnhq0IgIz/tEjKHcTySZjnv+ 7Y5aftTM0WyZr1OcNg18CXhQv6hqUFokYHnT7dVFaxgpJMo9COVqqnkLF05Q8F2yMAjV DIjZPFc8EZMAu4UIEuhR3SHhqLgi+vAvcqVZyb8QNAnFsUerXXRRGmII6yhMCw2SYHHY wi3w== X-Gm-Message-State: AOJu0Yy3SicyuOUtwt2ejPhH9GArXqiYztASwwFhbfWLoC0axldpzjq+ EwsIQ2NVEi0JhEh70E0BeTFtvDhleQfOOgZ31b54GA== X-Google-Smtp-Source: AGHT+IE4qgw1FtJj59Jhxpi9Tt1UcmImoW36r8Qz60M8tsRoRhpF4whc5AFDVdkJCGopSfQL7HTwHA== X-Received: by 2002:a5d:46d0:0:b0:321:6e68:ec3b with SMTP id g16-20020a5d46d0000000b003216e68ec3bmr8689266wrs.49.1695728798444; Tue, 26 Sep 2023 04:46:38 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:27f0:a2f3:f97:f30e]) by smtp.gmail.com with ESMTPSA id o13-20020a5d474d000000b003217cbab88bsm14379557wrs.16.2023.09.26.04.46.37 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 26 Sep 2023 04:46:38 -0700 (PDT) From: =?UTF-8?q?Marc=20Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Fix missing call to Finalize_Protection for simple protected objects Date: Tue, 26 Sep 2023 13:46:37 +0200 Message-ID: <20230926114637.3273120-1-poulhies@adacore.com> X-Mailer: git-send-email 2.42.0 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-13.7 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,GIT_PATCH_0,RCVD_IN_DNSWL_NONE,SPF_HELO_NONE,SPF_PASS,TXREP 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: Eric Botcazou There is a glitch in Exp_Ch7.Build_Finalizer causing the finalizer to do nothing for simple protected objects. The change also removes redundant calls to the Is_Simple_Protected_Type predicate and fixes a minor inconsistency between Requires_Cleanup_Actions and Build_Finalizer for this case. gcc/ada/ * exp_ch7.adb (Build_Finalizer.Process_Declarations): Remove call to Is_Simple_Protected_Type as redundant. (Build_Finalizer.Process_Object_Declaration): Do not retrieve the corresponding record type for simple protected objects. Make the flow of control more explicit in their specific processing. * exp_util.adb (Requires_Cleanup_Actions): Return false for simple protected objects present in library-level package bodies for the sake of consistency with Build_Finalizer and remove call to Is_Simple_Protected_Type as redundant. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch7.adb | 19 ++++++++++--------- gcc/ada/exp_util.adb | 32 ++++++++++++++++++++++++++++++-- 2 files changed, 40 insertions(+), 11 deletions(-) diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 585acd8b428..5049de54dd7 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -2356,8 +2356,7 @@ package body Exp_Ch7 is elsif Ekind (Obj_Id) = E_Variable and then not In_Library_Level_Package_Body (Obj_Id) - and then (Is_Simple_Protected_Type (Obj_Typ) - or else Has_Simple_Protected_Object (Obj_Typ)) + and then Has_Simple_Protected_Object (Obj_Typ) then Processing_Actions (Is_Protected => True); end if; @@ -3006,7 +3005,9 @@ package body Exp_Ch7 is -- Start of processing for Process_Object_Declaration begin - -- Handle the object type and the reference to the object + -- Handle the object type and the reference to the object. Note + -- that objects having simple protected components must retain + -- their original form for the processing below to work. Obj_Ref := New_Occurrence_Of (Obj_Id, Loc); Obj_Typ := Base_Type (Etype (Obj_Id)); @@ -3018,6 +3019,7 @@ package body Exp_Ch7 is elsif Is_Concurrent_Type (Obj_Typ) and then Present (Corresponding_Record_Type (Obj_Typ)) + and then not Is_Protected then Obj_Typ := Corresponding_Record_Type (Obj_Typ); Obj_Ref := Unchecked_Convert_To (Obj_Typ, Obj_Ref); @@ -3180,12 +3182,11 @@ package body Exp_Ch7 is Fin_Stmts := New_List (Fin_Call); end if; - elsif Has_Simple_Protected_Object (Obj_Typ) then - if Is_Record_Type (Obj_Typ) then - Fin_Stmts := Cleanup_Record (Decl, Obj_Ref, Obj_Typ); - elsif Is_Array_Type (Obj_Typ) then - Fin_Stmts := Cleanup_Array (Decl, Obj_Ref, Obj_Typ); - end if; + elsif Is_Array_Type (Obj_Typ) then + Fin_Stmts := Cleanup_Array (Decl, Obj_Ref, Obj_Typ); + + else + Fin_Stmts := Cleanup_Record (Decl, Obj_Ref, Obj_Typ); end if; -- Generate: diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 9ac64fe9381..1aff5a062ce 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -13100,10 +13100,38 @@ package body Exp_Util is -- Simple protected objects which use type System.Tasking. -- Protected_Objects.Protection to manage their locks should be -- treated as controlled since they require manual cleanup. + -- The only exception is illustrated in the following example: + + -- package Pkg is + -- type Ctrl is new Controlled ... + -- procedure Finalize (Obj : in out Ctrl); + -- Lib_Obj : Ctrl; + -- end Pkg; + + -- package body Pkg is + -- protected Prot is + -- procedure Do_Something (Obj : in out Ctrl); + -- end Prot; + + -- protected body Prot is + -- procedure Do_Something (Obj : in out Ctrl) is ... + -- end Prot; + + -- procedure Finalize (Obj : in out Ctrl) is + -- begin + -- Prot.Do_Something (Obj); + -- end Finalize; + -- end Pkg; + + -- Since for the most part entities in package bodies depend on + -- those in package specs, Prot's lock should be cleaned up + -- first. The subsequent cleanup of the spec finalizes Lib_Obj. + -- This act however attempts to invoke Do_Something and fails + -- because the lock has disappeared. elsif Ekind (Obj_Id) = E_Variable - and then (Is_Simple_Protected_Type (Obj_Typ) - or else Has_Simple_Protected_Object (Obj_Typ)) + and then not In_Library_Level_Package_Body (Obj_Id) + and then Has_Simple_Protected_Object (Obj_Typ) then return True; end if; -- 2.42.0