From patchwork Thu Oct 7 11:00:02 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 67032 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]) by ozlabs.org (Postfix) with SMTP id 77EF0B6F11 for ; Thu, 7 Oct 2010 22:00:13 +1100 (EST) Received: (qmail 19362 invoked by alias); 7 Oct 2010 11:00:10 -0000 Received: (qmail 19351 invoked by uid 22791); 7 Oct 2010 11:00:09 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD 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; Thu, 07 Oct 2010 11:00:04 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 3FD32CB01D4; Thu, 7 Oct 2010 13:00:02 +0200 (CEST) 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 ThvLpj+Eyb1v; Thu, 7 Oct 2010 13:00:02 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id 2C590CB026D; Thu, 7 Oct 2010 13:00:02 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 0F098D9BB5; Thu, 7 Oct 2010 13:00:02 +0200 (CEST) Date: Thu, 7 Oct 2010 13:00:02 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] No_Relative_Delay forbids Set_Handler calls Message-ID: <20101007110002.GA27889@adacore.com> Mime-Version: 1.0 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-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org A call to Ada.Real_Time.Timing_Events.Set_Handler violates restriction No_Relative_Delay (AI-0211). This patch implements this interpertation. The following compiled with -gnat05 -gnatws: pragma Restrictions (No_Relative_Delay); with Ada.Real_Time; use Ada.Real_Time; with Ada.Real_Time.Timing_Events; use Ada.Real_Time.Timing_Events; procedure NoRelDel is TE : Timing_Event; TEH : Timing_Event_Handler; TS : Time_Span; begin Set_Handler (TE, TS, TEH); end NoRelDel; Generates the output: noreldel.adb:10:04: violation of restriction "No_Relative_Delay" at line 1 Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-07 Robert Dewar * rtsfind.ads: Add entry for Ada.Real_Time.Timing_Events.Set_Handler * sem_res.adb (Resolve_Call): A call to Ada.Real_Time.Timing_Events.Set_Handler violates restriction No_Relative_Delay (AI-0211). Index: rtsfind.ads =================================================================== --- rtsfind.ads (revision 165081) +++ rtsfind.ads (working copy) @@ -536,7 +536,8 @@ package Rtsfind is RO_RT_Delay_Until, -- Ada.Real_Time.Delays RO_RT_To_Duration, -- Ada.Real_Time.Delays - RE_Timing_Event, -- Ada_Real_Time_Timing_Events + RE_Set_Handler, -- Ada_Real_Time.Timing_Events + RE_Timing_Event, -- Ada_Real_Time.Timing_Events RE_Root_Stream_Type, -- Ada.Streams RE_Stream_Element, -- Ada.Streams @@ -1707,6 +1708,7 @@ package Rtsfind is RO_RT_Delay_Until => Ada_Real_Time_Delays, RO_RT_To_Duration => Ada_Real_Time_Delays, + RE_Set_Handler => Ada_Real_Time_Timing_Events, RE_Timing_Event => Ada_Real_Time_Timing_Events, RE_Root_Stream_Type => Ada_Streams, Index: sem_res.adb =================================================================== --- sem_res.adb (revision 165084) +++ sem_res.adb (working copy) @@ -5554,6 +5554,13 @@ package body Sem_Res is Check_Potentially_Blocking_Operation (N); end if; + -- A call to Ada.Real_Time.Timing_Events.Set_Handler violates + -- restriction No_Relative_Delay (AI-0211). + + if Is_RTE (Nam, RE_Set_Handler) then + Check_Restriction (No_Relative_Delay, N); + end if; + -- Issue an error for a call to an eliminated subprogram. We skip this -- in a spec expression, e.g. a call in a default parameter value, since -- we are not really doing a call at this time. That's important because