comparison gcc/ada/libgnat/a-cobove.adb @ 145:1830386684a0

gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
131:84e7813d76e9 145:1830386684a0
4 -- -- 4 -- --
5 -- A D A . C O N T A I N E R S . B O U N D E D _ V E C T O R S -- 5 -- A D A . C O N T A I N E R S . B O U N D E D _ V E C T O R S --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 2004-2018, Free Software Foundation, Inc. -- 9 -- Copyright (C) 2004-2019, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- -- 12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- -- 13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
400 begin 400 begin
401 return R : constant Constant_Reference_Type := 401 return R : constant Constant_Reference_Type :=
402 (Element => A (J)'Access, 402 (Element => A (J)'Access,
403 Control => (Controlled with TC)) 403 Control => (Controlled with TC))
404 do 404 do
405 Lock (TC.all); 405 Busy (TC.all);
406 end return; 406 end return;
407 end; 407 end;
408 end Constant_Reference; 408 end Constant_Reference;
409 409
410 function Constant_Reference 410 function Constant_Reference
424 begin 424 begin
425 return R : constant Constant_Reference_Type := 425 return R : constant Constant_Reference_Type :=
426 (Element => A (J)'Access, 426 (Element => A (J)'Access,
427 Control => (Controlled with TC)) 427 Control => (Controlled with TC))
428 do 428 do
429 Lock (TC.all); 429 Busy (TC.all);
430 end return; 430 end return;
431 end; 431 end;
432 end Constant_Reference; 432 end Constant_Reference;
433 433
434 -------------- 434 --------------
449 449
450 function Copy 450 function Copy
451 (Source : Vector; 451 (Source : Vector;
452 Capacity : Count_Type := 0) return Vector 452 Capacity : Count_Type := 0) return Vector
453 is 453 is
454 C : Count_Type; 454 C : constant Count_Type :=
455 455 (if Capacity = 0 then Source.Length
456 begin 456 else Capacity);
457 if Capacity = 0 then 457 begin
458 C := Source.Length; 458 if Checks and then C < Source.Length then
459 459 raise Capacity_Error with "Capacity too small";
460 elsif Capacity >= Source.Length then
461 C := Capacity;
462
463 elsif Checks then
464 raise Capacity_Error
465 with "Requested capacity is less than Source length";
466 end if; 460 end if;
467 461
468 return Target : Vector (C) do 462 return Target : Vector (C) do
469 Target.Elements (1 .. Source.Length) := 463 Target.Elements (1 .. Source.Length) :=
470 Source.Elements (1 .. Source.Length); 464 Source.Elements (1 .. Source.Length);
2071 (Container : aliased Vector'Class) return Reference_Control_Type 2065 (Container : aliased Vector'Class) return Reference_Control_Type
2072 is 2066 is
2073 TC : constant Tamper_Counts_Access := Container.TC'Unrestricted_Access; 2067 TC : constant Tamper_Counts_Access := Container.TC'Unrestricted_Access;
2074 begin 2068 begin
2075 return R : constant Reference_Control_Type := (Controlled with TC) do 2069 return R : constant Reference_Control_Type := (Controlled with TC) do
2076 Lock (TC.all); 2070 Busy (TC.all);
2077 end return; 2071 end return;
2078 end Pseudo_Reference; 2072 end Pseudo_Reference;
2079 2073
2080 ------------------- 2074 -------------------
2081 -- Query_Element -- 2075 -- Query_Element --
2187 begin 2181 begin
2188 return R : constant Reference_Type := 2182 return R : constant Reference_Type :=
2189 (Element => A (J)'Access, 2183 (Element => A (J)'Access,
2190 Control => (Controlled with TC)) 2184 Control => (Controlled with TC))
2191 do 2185 do
2192 Lock (TC.all); 2186 Busy (TC.all);
2193 end return; 2187 end return;
2194 end; 2188 end;
2195 end Reference; 2189 end Reference;
2196 2190
2197 function Reference 2191 function Reference
2211 begin 2205 begin
2212 return R : constant Reference_Type := 2206 return R : constant Reference_Type :=
2213 (Element => A (J)'Access, 2207 (Element => A (J)'Access,
2214 Control => (Controlled with TC)) 2208 Control => (Controlled with TC))
2215 do 2209 do
2216 Lock (TC.all); 2210 Busy (TC.all);
2217 end return; 2211 end return;
2218 end; 2212 end;
2219 end Reference; 2213 end Reference;
2220 2214
2221 --------------------- 2215 ---------------------