From patchwork Tue Nov 24 09:00:11 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Eric Botcazou X-Patchwork-Id: 547899 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 80D0F140316 for ; Tue, 24 Nov 2015 20:01:04 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=gP41Q3Xq; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; q=dns; s=default; b=RdHPb0DAbG5GiF+5 +kSYJSXMk2gwbj2kvnP7iqAx0XpfR6QNSjYNjrHLeTjPHfEqBi2Ak91QDaVJb7l0 tvlmA5gnel0R22kGShixecjBgJy16jCm6tXIZCuEgOLpjhCaqYMnQWPV86kbOEhr A/QS498uzAMEmkFUqyXBbBcoiMo= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; s=default; bh=WN1t+3iO5zrkkH5ojUCsxV jN1EU=; b=gP41Q3Xq1KkSHWUDaYauax6X6Yr3Jbtz71F0yOBDD7bNH9N+evhByx N3I0QS5lr92Hqy9z/e2R5/WLFMZ4t3Wx+ATjK7+mxC5aG/rR9mTwa9I2Eirs41Kk uVBJnHPKMjCrG+4T/nOgONtn3GmS/S6jUrurdaKKzjMGLJGDAvbCo= Received: (qmail 94987 invoked by alias); 24 Nov 2015 09:00:57 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 94977 invoked by uid 89); 24 Nov 2015 09:00:57 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=0.1 required=5.0 tests=AWL, BAYES_50, KAM_ASCII_DIVIDERS, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_LOW autolearn=no version=3.3.2 X-HELO: smtp.eu.adacore.com Received: from mel.act-europe.fr (HELO smtp.eu.adacore.com) (194.98.77.210) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Tue, 24 Nov 2015 09:00:52 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id BE1E83527751 for ; Tue, 24 Nov 2015 10:00:49 +0100 (CET) Received: from smtp.eu.adacore.com ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id vMfjuywJzd4R for ; Tue, 24 Nov 2015 10:00:49 +0100 (CET) Received: from polaris.localnet (bon31-6-88-161-99-133.fbx.proxad.net [88.161.99.133]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by smtp.eu.adacore.com (Postfix) with ESMTPSA id 9868A3527742 for ; Tue, 24 Nov 2015 10:00:49 +0100 (CET) From: Eric Botcazou To: gcc-patches@gcc.gnu.org Subject: [Ada] Process entry, protected and task bodies in ASIS mode. Date: Tue, 24 Nov 2015 10:00:11 +0100 Message-ID: <9112261.Bc1GBQSeli@polaris> User-Agent: KMail/4.14.9 (Linux/3.16.7-29-desktop; KDE/4.14.9; x86_64; ; ) MIME-Version: 1.0 Tested on x86_64-suse-linux, applied on the mainline. 2015-11-24 Eric Botcazou * gcc-interface/decl.c (gnat_to_gnu_entity) : In ASIS mode, do a minimal translation for root types with discriminants. * gcc-interface/trans.c (gnat_to_gnu) : Move around. : Likewise. In ASIS mode, process the declarations attached to the body. Index: gcc-interface/decl.c =================================================================== --- gcc-interface/decl.c (revision 230788) +++ gcc-interface/decl.c (working copy) @@ -4737,13 +4737,51 @@ gnat_to_gnu_entity (Entity_Id gnat_entit maybe_present = true; break; - case E_Task_Type: - case E_Task_Subtype: case E_Protected_Type: case E_Protected_Subtype: - /* Concurrent types are always transformed into their record type. */ + case E_Task_Type: + case E_Task_Subtype: + /* If we are just annotating types and have no equivalent record type, + just return void_type, except for root types that have discriminants + because the discriminants will very likely be used in the declarative + part of the associated body so they need to be translated. */ if (type_annotate_only && No (gnat_equiv_type)) - gnu_type = void_type_node; + { + if (Has_Discriminants (gnat_entity) + && Root_Type (gnat_entity) == gnat_entity) + { + tree gnu_field_list = NULL_TREE; + Entity_Id gnat_field; + + /* This is a minimal version of the E_Record_Type handling. */ + gnu_type = make_node (RECORD_TYPE); + TYPE_NAME (gnu_type) = gnu_entity_name; + + for (gnat_field = First_Stored_Discriminant (gnat_entity); + Present (gnat_field); + gnat_field = Next_Stored_Discriminant (gnat_field)) + { + tree gnu_field + = gnat_to_gnu_field (gnat_field, gnu_type, false, + definition, debug_info_p); + + save_gnu_tree (gnat_field, + build3 (COMPONENT_REF, TREE_TYPE (gnu_field), + build0 (PLACEHOLDER_EXPR, gnu_type), + gnu_field, NULL_TREE), + true); + + DECL_CHAIN (gnu_field) = gnu_field_list; + gnu_field_list = gnu_field; + } + + TYPE_FIELDS (gnu_type) = nreverse (gnu_field_list); + } + else + gnu_type = void_type_node; + } + + /* Concurrent types are always transformed into their record type. */ else gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, 0); maybe_present = true; Index: gcc-interface/trans.c =================================================================== --- gcc-interface/trans.c (revision 230791) +++ gcc-interface/trans.c (working copy) @@ -7272,6 +7272,19 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result = alloc_stmt_list (); break; + case N_Subunit: + gnu_result = gnat_to_gnu (Proper_Body (gnat_node)); + break; + + case N_Entry_Body: + case N_Protected_Body: + case N_Task_Body: + /* These nodes should only be present when annotating types. */ + gcc_assert (type_annotate_only); + process_decls (Declarations (gnat_node), Empty, Empty, true, true); + gnu_result = alloc_stmt_list (); + break; + case N_Subprogram_Body_Stub: case N_Package_Body_Stub: case N_Protected_Body_Stub: @@ -7286,10 +7299,6 @@ gnat_to_gnu (Node_Id gnat_node) } break; - case N_Subunit: - gnu_result = gnat_to_gnu (Proper_Body (gnat_node)); - break; - /***************************/ /* Chapter 11: Exceptions */ /***************************/ @@ -7662,8 +7671,6 @@ gnat_to_gnu (Node_Id gnat_node) case N_Procedure_Specification: case N_Op_Concat: case N_Component_Association: - case N_Protected_Body: - case N_Task_Body: /* These nodes should only be present when annotating types. */ gcc_assert (type_annotate_only); gnu_result = alloc_stmt_list ();