Mercurial > hg > CbC > CbC_gcc

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 _ O R D E R E D _ M A P S -- 5 -- A D A . C O N T A I N E R S . B O U N D E D _ O R D E R E D _ M A P 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- --
372 -- Clear -- 372 -- Clear --
373 ----------- 373 -----------
374 374
375 procedure Clear (Container : in out Map) is 375 procedure Clear (Container : in out Map) is
376 begin 376 begin
377 Tree_Operations.Clear_Tree (Container); 377 while not Container.Is_Empty loop
378 Container.Delete_Last;
379 end loop;
378 end Clear; 380 end Clear;
379 381
380 ----------- 382 -----------
381 -- Color -- 383 -- Color --
382 ----------- 384 -----------
416 begin 418 begin
417 return R : constant Constant_Reference_Type := 419 return R : constant Constant_Reference_Type :=
418 (Element => N.Element'Access, 420 (Element => N.Element'Access,
419 Control => (Controlled with TC)) 421 Control => (Controlled with TC))
420 do 422 do
421 Lock (TC.all); 423 Busy (TC.all);
422 end return; 424 end return;
423 end; 425 end;
424 end Constant_Reference; 426 end Constant_Reference;
425 427
426 function Constant_Reference 428 function Constant_Reference
441 begin 443 begin
442 return R : constant Constant_Reference_Type := 444 return R : constant Constant_Reference_Type :=
443 (Element => N.Element'Access, 445 (Element => N.Element'Access,
444 Control => (Controlled with TC)) 446 Control => (Controlled with TC))
445 do 447 do
446 Lock (TC.all); 448 Busy (TC.all);
447 end return; 449 end return;
448 end; 450 end;
449 end Constant_Reference; 451 end Constant_Reference;
450 452
451 -------------- 453 --------------
460 ---------- 462 ----------
461 -- Copy -- 463 -- Copy --
462 ---------- 464 ----------
463 465
464 function Copy (Source : Map; Capacity : Count_Type := 0) return Map is 466 function Copy (Source : Map; Capacity : Count_Type := 0) return Map is
465 C : Count_Type; 467 C : constant Count_Type :=
466 468 (if Capacity = 0 then Source.Length
467 begin 469 else Capacity);
468 if Capacity = 0 then 470 begin
469 C := Source.Length; 471 if Checks and then C < Source.Length then
470 472 raise Capacity_Error with "Capacity too small";
471 elsif Capacity >= Source.Length then
472 C := Capacity;
473
474 elsif Checks then
475 raise Capacity_Error with "Capacity value too small";
476 end if; 473 end if;
477 474
478 return Target : Map (Capacity => C) do 475 return Target : Map (Capacity => C) do
479 Assign (Target => Target, Source => Source); 476 Assign (Target => Target, Source => Source);
480 end return; 477 end return;
1257 is 1254 is
1258 TC : constant Tamper_Counts_Access := 1255 TC : constant Tamper_Counts_Access :=
1259 Container.TC'Unrestricted_Access; 1256 Container.TC'Unrestricted_Access;
1260 begin 1257 begin
1261 return R : constant Reference_Control_Type := (Controlled with TC) do 1258 return R : constant Reference_Control_Type := (Controlled with TC) do
1262 Lock (TC.all); 1259 Busy (TC.all);
1263 end return; 1260 end return;
1264 end Pseudo_Reference; 1261 end Pseudo_Reference;
1265 1262
1266 ------------------- 1263 -------------------
1267 -- Query_Element -- 1264 -- Query_Element --
1377 begin 1374 begin
1378 return R : constant Reference_Type := 1375 return R : constant Reference_Type :=
1379 (Element => N.Element'Access, 1376 (Element => N.Element'Access,
1380 Control => (Controlled with TC)) 1377 Control => (Controlled with TC))
1381 do 1378 do
1382 Lock (TC.all); 1379 Busy (TC.all);
1383 end return; 1380 end return;
1384 end; 1381 end;
1385 end Reference; 1382 end Reference;
1386 1383
1387 function Reference 1384 function Reference
1402 begin 1399 begin
1403 return R : constant Reference_Type := 1400 return R : constant Reference_Type :=
1404 (Element => N.Element'Access, 1401 (Element => N.Element'Access,
1405 Control => (Controlled with TC)) 1402 Control => (Controlled with TC))
1406 do 1403 do
1407 Lock (TC.all); 1404 Busy (TC.all);
1408 end return; 1405 end return;
1409 end; 1406 end;
1410 end Reference; 1407 end Reference;
1411 1408
1412 ------------- 1409 -------------