From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 2994 invoked by alias); 30 Nov 2009 13:46:13 -0000 Received: (qmail 2977 invoked by uid 22791); 30 Nov 2009 13:46:13 -0000 X-SWARE-Spam-Status: No, hits=-2.2 required=5.0 tests=AWL,BAYES_00 X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 30 Nov 2009 13:46:07 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id B62AE290078; Mon, 30 Nov 2009 14:46:05 +0100 (CET) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id reQUnixkZ1Mw; Mon, 30 Nov 2009 14:46:04 +0100 (CET) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id BE6F1290022; Mon, 30 Nov 2009 14:46:04 +0100 (CET) Received: by saumur.act-europe.fr (Postfix, from userid 525) id B019DD9AB2; Mon, 30 Nov 2009 14:46:04 +0100 (CET) Date: Mon, 30 Nov 2009 13:46:00 -0000 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: =?iso-8859-1?B?Suly9G1l?= Lambourg Subject: [Ada] Improve handling of valuetypes and delegates from the CIL compiler Message-ID: <20091130134604.GA24070@adacore.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="5mCyUwZo2JvN/JJP" Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org X-SW-Source: 2009-11/txt/msg01680.txt.bz2 --5mCyUwZo2JvN/JJP Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-length: 587 This is for the benefit of the cil GNAT back-end Tested on x86_64-pc-linux-gnu, committed on trunk 2009-11-30 Jerome Lambourg * exp_ch3.adb (Make_Predefined_Primitive_Specs): Take care of CIL ValueTypes. * exp_ch7.adb (Needs_Finalization): Do not finalize CIL valuetypes. * sem_util.adb (Is_Value_Type): Protect against invalid calls to Chars (Is_Delegate): New method used for CIL. * sem_util.ads (Is_Delegate): New method for CIL handling. (Is_Value_Type): Improve documentation. Improve handling of valuetypes and delegates from the CIL compiler. --5mCyUwZo2JvN/JJP Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename=difs Content-length: 4065 Index: exp_ch7.adb =================================================================== --- exp_ch7.adb (revision 154755) +++ exp_ch7.adb (working copy) @@ -3294,7 +3294,8 @@ package body Exp_Ch7 is return (Is_Class_Wide_Type (T) and then not In_Finalization_Root (T) - and then not Restriction_Active (No_Finalization)) + and then not Restriction_Active (No_Finalization) + and then not Is_Value_Type (Etype (T))) or else Is_Controlled (T) or else Has_Some_Controlled_Component (T) or else (Is_Concurrent_Type (T) Index: sem_util.adb =================================================================== --- sem_util.adb (revision 154791) +++ sem_util.adb (working copy) @@ -7040,11 +7040,55 @@ package body Sem_Util is function Is_Value_Type (T : Entity_Id) return Boolean is begin return VM_Target = CLI_Target + and then Nkind (T) in N_Has_Chars and then Chars (T) /= No_Name and then Get_Name_String (Chars (T)) = "valuetype"; end Is_Value_Type; ----------------- + -- Is_Delegate -- + ----------------- + + function Is_Delegate (T : Entity_Id) return Boolean is + Desig_Type : Entity_Id; + begin + if VM_Target /= CLI_Target then + return False; + end if; + + -- Access-to-subprograms are delegates in CIL + if Ekind (T) = E_Access_Subprogram_Type then + return True; + end if; + + if Ekind (T) not in Access_Kind then + -- a delegate is a managed pointer. If no designated type is defined + -- it means that it's not a delegate. + return False; + end if; + + Desig_Type := Etype (Directly_Designated_Type (T)); + + if not Is_Tagged_Type (Desig_Type) then + return False; + end if; + + -- Test if the type is inherited from [mscorlib]System.Delegate + while Etype (Desig_Type) /= Desig_Type loop + if Chars (Scope (Desig_Type)) /= No_Name + and then Is_Imported (Scope (Desig_Type)) + and then Get_Name_String (Chars (Scope (Desig_Type))) = "delegate" + then + return True; + end if; + + Desig_Type := Etype (Desig_Type); + end loop; + + return False; + end Is_Delegate; + + ----------------- -- Is_Variable -- ----------------- Index: sem_util.ads =================================================================== --- sem_util.ads (revision 154791) +++ sem_util.ads (working copy) @@ -800,8 +800,14 @@ package Sem_Util is function Is_Value_Type (T : Entity_Id) return Boolean; -- Returns true if type T represents a value type. This is only relevant to -- CIL, will always return false for other targets. - -- What is a "value type", since this is not an Ada term, it should be - -- defined here ??? + -- A value type is a CIL object that is accessed directly, as opposed to + -- the other CIL objects that are accessed through managed pointers. + + function Is_Delegate (T : Entity_Id) return Boolean; + -- Returns true if type T represents a delegate. A Delegate is the CIL + -- object used to represent access-to-subprogram types. + -- This is only relevant to CIL, will always return false for other + -- targets. function Is_Variable (N : Node_Id) return Boolean; -- Determines if the tree referenced by N represents a variable, i.e. Index: exp_ch3.adb =================================================================== --- exp_ch3.adb (revision 154755) +++ exp_ch3.adb (working copy) @@ -8121,7 +8121,9 @@ package body Exp_Ch3 is and then not Is_Limited_Interface (Tag_Typ) and then Is_Limited_Interface (Etype (Tag_Typ))) then - if not Is_Limited_Type (Tag_Typ) then + if not Is_Limited_Type (Tag_Typ) + and then not Is_Value_Type (Tag_Typ) + then Append_To (Res, Predef_Deep_Spec (Loc, Tag_Typ, TSS_Deep_Adjust)); end if; --5mCyUwZo2JvN/JJP--