Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gnat.dg/entry1.adb @ 158:494b0b89df80 default tip
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 25 May 2020 18:13:55 +0900 |
parents | 1830386684a0 |
children |
line wrap: on
line source
-- { dg-do compile } -- { dg-options "-gnateF" } PACKAGE BODY Entry1 IS PROTECTED TYPE key_buffer IS PROCEDURE clear; ENTRY incr; ENTRY put (val : IN Natural); ENTRY get (val : OUT Natural); PRIVATE -- Stores Key states (key state controller) -- purpose: exclusive access max_len : Natural := 10; cnt : Natural := 0; END key_buffer; PROTECTED BODY key_buffer IS PROCEDURE clear IS BEGIN cnt := 0; END clear; ENTRY incr WHEN cnt < max_len IS BEGIN cnt := cnt + 1; END; ENTRY put (val : IN Natural) WHEN cnt < max_len IS BEGIN cnt := val; END put; ENTRY get (val : OUT Natural) WHEN cnt > 0 IS BEGIN val := cnt; END get; END key_buffer; my_buffer : key_buffer; FUNCTION pt2 (t : IN Float) RETURN Natural IS c : Natural; t2 : duration := duration (t); BEGIN SELECT my_buffer.get (c); RETURN c; OR DELAY t2; RETURN 0; END SELECT; END pt2; FUNCTION pt (t : IN Float) RETURN Natural IS c : Natural; BEGIN SELECT my_buffer.get (c); RETURN c; OR DELAY Duration (t); RETURN 0; END SELECT; END pt; END Entry1;