From patchwork Wed Jun 22 10:37:24 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 639090 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 3rZLdr08TZz9t0W for ; Wed, 22 Jun 2016 20:37:50 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=FSKRBZ79; 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:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=mzqA4Eu5qj6gM4eQa9grlzvivqvDTNIh9Jm6nT1FVm9QSJxnvr 3V/JI8DKwU9spDBek9P1WVDlG8sgrrU4I4NcrdPdF9mX2yvSNjWQhleRpok1ag6i NMVEb/efUM5zCCYNdD+7wCHfv+TjxHSZ37xSQ/04qSY2Z2aV3Y1Fb1ECY= 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:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=b8QsRNnT/RrBoI2VV0Yr25JI9UA=; b=FSKRBZ79sVpUN+0DUs89 s0jLA0Kj+riaPjtxX65OEo80UUoCa6JE8S6VYUOdarF4bEsDCgx9lKfmYwWKuoJF Gl1EwbUF6oi9ZgnSMyNkcwr7+jEhK5M2eLiKu9r+Bxr6MZa+5aN8wbaYZRPzXfOJ E0ufSViDrwV5RKeHUJq87p8= Received: (qmail 52562 invoked by alias); 22 Jun 2016 10:37:40 -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 52472 invoked by uid 89); 22 Jun 2016 10:37:39 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.1 required=5.0 tests=BAYES_00, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=no version=3.3.2 spammy=sem_prag.adb, sem_pragadb, UD:sem_prag.adb, sem_res.adb X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Wed, 22 Jun 2016 10:37:26 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 96D6B116658; Wed, 22 Jun 2016 06:37:24 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id K54reeZMOwie; Wed, 22 Jun 2016 06:37:24 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 87438116643; Wed, 22 Jun 2016 06:37:24 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 837673F0; Wed, 22 Jun 2016 06:37:24 -0400 (EDT) Date: Wed, 22 Jun 2016 06:37:24 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Justin Squirek Subject: [Ada] Analysis of pragmas containing integer expressions not verified properly Message-ID: <20160622103724.GA26750@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) If a string is used as an argument instead of an integer, Check_Arg_Is_OK_Static_Expression with Any_Integer will falsely verify causing the compiler to halt compilation when the caller acts on the assumption that it was verified. This patch creates checks so that Any_Integer works properly and documentation to explain how unresolved types get handled. ------------ -- Source -- ------------ -- static_int_test.adb pragma C_Pass_By_Copy("JUNK"); -- Expects a static integer expression procedure Static_Int_Test is Another_Error : String := 1; begin null; end Static_Int_Test; ---------------------------- -- Compilation and output -- ---------------------------- $ gnatmake -q -f static_int_test.adb static_int_test.adb:1:23: expected an integer type static_int_test.adb:1:23: found a string type static_int_test.adb:3:30: expected type "Standard.String" static_int_test.adb:3:30: found type universal integer gnatmake: "static_int_test.adb" compilation error Tested on x86_64-pc-linux-gnu, committed on trunk 2016-06-22 Justin Squirek * sem_prag.adb (Check_Expr_Is_OK_Static_Expression): Fix ordering of if-block and add in a condition to test for errors during resolution. * sem_res.adb (Resolution_Failed): Add comment to explain why the type of a node which failed to resolve is set to the desired type instead of Any_Type. * sem_ch8.adb (Analyze_Object_Renaming): Add a check for Any_Type to prevent crashes on Is_Access_Constant. Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 237686) +++ sem_prag.adb (working copy) @@ -5060,12 +5060,15 @@ Analyze_And_Resolve (Expr); end if; - if Is_OK_Static_Expression (Expr) then - return; + -- An expression cannot be considered static if its resolution failed + -- or if it erroneous. Stop the analysis of the related pragma. - elsif Etype (Expr) = Any_Type then + if Etype (Expr) = Any_Type or else Error_Posted (Expr) then raise Pragma_Exit; + elsif Is_OK_Static_Expression (Expr) then + return; + -- An interesting special case, if we have a string literal and we -- are in Ada 83 mode, then we allow it even though it will not be -- flagged as static. This allows the use of Ada 95 pragmas like @@ -5077,12 +5080,6 @@ then return; - -- Static expression that raises Constraint_Error. This has already - -- been flagged, so just exit from pragma processing. - - elsif Is_OK_Static_Expression (Expr) then - raise Pragma_Exit; - -- Finally, we have a real error else Index: sem_res.adb =================================================================== --- sem_res.adb (revision 237680) +++ sem_res.adb (working copy) @@ -1974,7 +1974,12 @@ procedure Resolution_Failed is begin Patch_Up_Value (N, Typ); + + -- Set the type to the desired one to minimize cascaded errors. Note + -- that this is an approximation and does not work in all cases. + Set_Etype (N, Typ); + Debug_A_Exit ("resolving ", N, " (done, resolution failed)"); Set_Is_Overloaded (N, False); Index: sem_ch8.adb =================================================================== --- sem_ch8.adb (revision 237680) +++ sem_ch8.adb (working copy) @@ -1022,22 +1022,30 @@ Resolve (Nam, T); + -- Do not perform the legality checks below when the resolution of + -- the renaming name failed because the associated type is Any_Type. + + if Etype (Nam) = Any_Type then + null; + -- Ada 2005 (AI-231): In the case where the type is defined by an -- access_definition, the renamed entity shall be of an access-to- -- constant type if and only if the access_definition defines an -- access-to-constant type. ARM 8.5.1(4) - if Constant_Present (Access_Definition (N)) + elsif Constant_Present (Access_Definition (N)) and then not Is_Access_Constant (Etype (Nam)) then - Error_Msg_N ("(Ada 2005): the renamed object is not " - & "access-to-constant (RM 8.5.1(6))", N); + Error_Msg_N + ("(Ada 2005): the renamed object is not access-to-constant " + & "(RM 8.5.1(6))", N); elsif not Constant_Present (Access_Definition (N)) and then Is_Access_Constant (Etype (Nam)) then - Error_Msg_N ("(Ada 2005): the renamed object is not " - & "access-to-variable (RM 8.5.1(6))", N); + Error_Msg_N + ("(Ada 2005): the renamed object is not access-to-variable " + & "(RM 8.5.1(6))", N); end if; if Is_Access_Subprogram_Type (Etype (Nam)) then