2010-10-25 15:50:29 +02:00
|
|
|
------------------------------------------------------------------------------
|
|
|
|
-- --
|
|
|
|
-- GNAT LIBRARY COMPONENTS --
|
|
|
|
-- --
|
|
|
|
-- 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 --
|
|
|
|
-- --
|
|
|
|
-- B o d y --
|
|
|
|
-- --
|
2012-01-30 13:16:12 +01:00
|
|
|
-- Copyright (C) 2004-2012, Free Software Foundation, Inc. --
|
2010-10-25 15:50:29 +02:00
|
|
|
-- --
|
|
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
|
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
|
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
|
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
|
|
-- or FITNESS FOR A PARTICULAR PURPOSE. --
|
|
|
|
-- --
|
|
|
|
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
|
-- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
|
-- version 3.1, as published by the Free Software Foundation. --
|
|
|
|
-- --
|
|
|
|
-- You should have received a copy of the GNU General Public License and --
|
|
|
|
-- a copy of the GCC Runtime Library Exception along with this program; --
|
|
|
|
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
|
|
-- <http://www.gnu.org/licenses/>. --
|
|
|
|
-- --
|
|
|
|
-- This unit was originally developed by Matthew J Heaney. --
|
|
|
|
------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
with Ada.Containers.Generic_Array_Sort;
|
[multiple changes]
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Freeze_All_Ent): An incomplete type is not
frozen by a subprogram body that does not come from source.
2011-11-23 Pascal Obry <obry@adacore.com>
* s-oscons-tmplt.c: Add PTY_Library constant. It contains
the library for pseudo terminal support.
* g-exptty.ads: Add pseudo-terminal library into a Linker_Options
pragma.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch9.adb: No check on entry family index if generic.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* sem_ch9.adb, s-taprop.ads, s-taprop-hpux-dce.adb, s-taprop-irix.adb,
s-taprop-posix.adb, s-taprop-rtx.adb, s-taprop-solaris.adb,
s-taprop-tru64.adb, s-taprop-vxworks.adb: Move dependency on
System.OS_Constants from shared spec of
System.Tasking.Primitive_Operations to the specific body variants
that really require this dependency.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming_Declaration):
If the declaration has aspects, analyze them so they can be
properly rejected.
2011-11-23 Hristian Kirtchev <kirtchev@adacore.com>
* a-comutr.adb, a-coorma.adb, a-coorse.adb, a-convec.adb, a-cihase.adb,
a-cimutr.adb, a-coinve.adb, a-ciorma.adb, a-ciorse.adb, a-cobove.adb,
a-cohama.adb, a-cihama.adb, a-cidlli.adb, a-cdlili.adb, a-cbhama.adb,
a-cbhase.adb, a-cbmutr.adb, a-cborma.adb, a-cborse.adb, a-cbdlli.adb:
Add with and use clause for Ada.Finalization. Type
Iterator and Child_Iterator are now derived from Limited_Controlled.
(Finalize): New routine.
(Iterate): Add a renaming of counter Busy and
increment it. Update the return aggregate.
(Iterate_Children): Add a renaming of
counter Busy and increment it. Update the return aggregate.
(Iterate_Subtree): Add a renaming of counter Busy and increment
it. Update the return aggregate.
* a-cdlili.ads, a-cidlli.ads: Type List_Access is now a general access
type.
* a-cihama.ads: Type Map_Access is now a general access type.
* a-comutr.ads, a-cimutr.ads: Use type Natural for the two locks
associated with the tree.
* a-cohama.ads: Type Map_Access is now a general access type.
* a-coinve.ads, a-convec.ads: Type Vector_Access is now a general
access type.
* exp_ch5.adb (Expand_Iterator_Loop): Do not create a block
to wrap the loop as this is done at an earlier step, during
analysis. The declarations of the iterator and the cursor use
the usual Insert_Action mechanism when added into the tree.
* sem_ch5.adb (Analyze_Loop_Statement): Remove local constant
Loop_Statement and replace all respective uses by N. Add local
constant Loc. Preanalyze the loop iterator to discover whether
it is a container iterator and if it is, wrap the loop in a
block. This ensures that any controlled temporaries produced
by the iteration scheme share the same lifetime of the loop.
(Is_Container_Iterator): New routine.
(Is_Wrapped_In_Block): New routine.
(Pre_Analyze_Range): Move spec and body to the library level.
2011-11-23 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi, vms_data.ads: Add documentation for new gnatpp option
that controls casing of type and subtype names.
2011-11-23 Yannick Moy <moy@adacore.com>
* sem_ch3.adb: Minor addition of comments.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* prj-part.adb (Extension_Withs): New global variable,
contains the head of the list of WITH clauses from the EXTENDS
ALL projects for which virtual packages are being created.
(Look_For_Virtual_Projects_For): When recursing through
an EXTENDS ALL, add the WITH clauses of the extending
project to Extension_Withs. When adding a project to the
Virtual_Hash, record the associated Extension_Withs list.
(Create_Virtual_Extending_Project): Add a copy of the appropriate
Extension_Withs to the virtual project.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* mlib-tgt-specific-vxworks.adb: Minor reformatting.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* Make-generated.in (Sdefault.Target_Name): Set to
$(target_noncanonical) instead of $(target) for consistency.
From-SVN: r181668
2011-11-23 14:51:23 +01:00
|
|
|
with Ada.Finalization; use Ada.Finalization;
|
[multiple changes]
2011-12-02 Matthew Heaney <heaney@adacore.com>
* a-coormu.ads, a-ciormu.ads: Declare iterator factory function.
* a-ciormu.adb, a-ciormu.adb (Iterator): Declare concrete
Iterator type.
(Finalize): Decrement busy counter.
(First, Last): Cursor return value depends on iterator node value.
(Iterate): Use start position as iterator node value.
(Next, Previous): Forward to corresponding cursor-based operation.
2011-12-02 Robert Dewar <dewar@adacore.com>
* a-cborma.adb, a-cbhama.adb, a-cbdlli.adb, a-cbmutr.adb,
a-cbhase.adb, a-cdlili.adb, a-cihama.adb, a-ciorse.adb, a-cidlli.adb,
a-cimutr.adb, a-cihase.adb, a-cohama.adb, a-cborse.adb,
a-ciorma.adb, a-cobove.adb: Minor reformatting.
From-SVN: r181912
2011-12-02 15:36:31 +01:00
|
|
|
|
2010-10-25 15:50:29 +02:00
|
|
|
with System; use type System.Address;
|
|
|
|
|
|
|
|
package body Ada.Containers.Bounded_Vectors is
|
|
|
|
|
[multiple changes]
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Freeze_All_Ent): An incomplete type is not
frozen by a subprogram body that does not come from source.
2011-11-23 Pascal Obry <obry@adacore.com>
* s-oscons-tmplt.c: Add PTY_Library constant. It contains
the library for pseudo terminal support.
* g-exptty.ads: Add pseudo-terminal library into a Linker_Options
pragma.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch9.adb: No check on entry family index if generic.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* sem_ch9.adb, s-taprop.ads, s-taprop-hpux-dce.adb, s-taprop-irix.adb,
s-taprop-posix.adb, s-taprop-rtx.adb, s-taprop-solaris.adb,
s-taprop-tru64.adb, s-taprop-vxworks.adb: Move dependency on
System.OS_Constants from shared spec of
System.Tasking.Primitive_Operations to the specific body variants
that really require this dependency.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming_Declaration):
If the declaration has aspects, analyze them so they can be
properly rejected.
2011-11-23 Hristian Kirtchev <kirtchev@adacore.com>
* a-comutr.adb, a-coorma.adb, a-coorse.adb, a-convec.adb, a-cihase.adb,
a-cimutr.adb, a-coinve.adb, a-ciorma.adb, a-ciorse.adb, a-cobove.adb,
a-cohama.adb, a-cihama.adb, a-cidlli.adb, a-cdlili.adb, a-cbhama.adb,
a-cbhase.adb, a-cbmutr.adb, a-cborma.adb, a-cborse.adb, a-cbdlli.adb:
Add with and use clause for Ada.Finalization. Type
Iterator and Child_Iterator are now derived from Limited_Controlled.
(Finalize): New routine.
(Iterate): Add a renaming of counter Busy and
increment it. Update the return aggregate.
(Iterate_Children): Add a renaming of
counter Busy and increment it. Update the return aggregate.
(Iterate_Subtree): Add a renaming of counter Busy and increment
it. Update the return aggregate.
* a-cdlili.ads, a-cidlli.ads: Type List_Access is now a general access
type.
* a-cihama.ads: Type Map_Access is now a general access type.
* a-comutr.ads, a-cimutr.ads: Use type Natural for the two locks
associated with the tree.
* a-cohama.ads: Type Map_Access is now a general access type.
* a-coinve.ads, a-convec.ads: Type Vector_Access is now a general
access type.
* exp_ch5.adb (Expand_Iterator_Loop): Do not create a block
to wrap the loop as this is done at an earlier step, during
analysis. The declarations of the iterator and the cursor use
the usual Insert_Action mechanism when added into the tree.
* sem_ch5.adb (Analyze_Loop_Statement): Remove local constant
Loop_Statement and replace all respective uses by N. Add local
constant Loc. Preanalyze the loop iterator to discover whether
it is a container iterator and if it is, wrap the loop in a
block. This ensures that any controlled temporaries produced
by the iteration scheme share the same lifetime of the loop.
(Is_Container_Iterator): New routine.
(Is_Wrapped_In_Block): New routine.
(Pre_Analyze_Range): Move spec and body to the library level.
2011-11-23 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi, vms_data.ads: Add documentation for new gnatpp option
that controls casing of type and subtype names.
2011-11-23 Yannick Moy <moy@adacore.com>
* sem_ch3.adb: Minor addition of comments.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* prj-part.adb (Extension_Withs): New global variable,
contains the head of the list of WITH clauses from the EXTENDS
ALL projects for which virtual packages are being created.
(Look_For_Virtual_Projects_For): When recursing through
an EXTENDS ALL, add the WITH clauses of the extending
project to Extension_Withs. When adding a project to the
Virtual_Hash, record the associated Extension_Withs list.
(Create_Virtual_Extending_Project): Add a copy of the appropriate
Extension_Withs to the virtual project.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* mlib-tgt-specific-vxworks.adb: Minor reformatting.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* Make-generated.in (Sdefault.Target_Name): Set to
$(target_noncanonical) instead of $(target) for consistency.
From-SVN: r181668
2011-11-23 14:51:23 +01:00
|
|
|
type Iterator is new Limited_Controlled and
|
|
|
|
Vector_Iterator_Interfaces.Reversible_Iterator with
|
|
|
|
record
|
|
|
|
Container : Vector_Access;
|
2011-12-12 12:28:03 +01:00
|
|
|
Index : Index_Type'Base;
|
[multiple changes]
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Freeze_All_Ent): An incomplete type is not
frozen by a subprogram body that does not come from source.
2011-11-23 Pascal Obry <obry@adacore.com>
* s-oscons-tmplt.c: Add PTY_Library constant. It contains
the library for pseudo terminal support.
* g-exptty.ads: Add pseudo-terminal library into a Linker_Options
pragma.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch9.adb: No check on entry family index if generic.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* sem_ch9.adb, s-taprop.ads, s-taprop-hpux-dce.adb, s-taprop-irix.adb,
s-taprop-posix.adb, s-taprop-rtx.adb, s-taprop-solaris.adb,
s-taprop-tru64.adb, s-taprop-vxworks.adb: Move dependency on
System.OS_Constants from shared spec of
System.Tasking.Primitive_Operations to the specific body variants
that really require this dependency.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming_Declaration):
If the declaration has aspects, analyze them so they can be
properly rejected.
2011-11-23 Hristian Kirtchev <kirtchev@adacore.com>
* a-comutr.adb, a-coorma.adb, a-coorse.adb, a-convec.adb, a-cihase.adb,
a-cimutr.adb, a-coinve.adb, a-ciorma.adb, a-ciorse.adb, a-cobove.adb,
a-cohama.adb, a-cihama.adb, a-cidlli.adb, a-cdlili.adb, a-cbhama.adb,
a-cbhase.adb, a-cbmutr.adb, a-cborma.adb, a-cborse.adb, a-cbdlli.adb:
Add with and use clause for Ada.Finalization. Type
Iterator and Child_Iterator are now derived from Limited_Controlled.
(Finalize): New routine.
(Iterate): Add a renaming of counter Busy and
increment it. Update the return aggregate.
(Iterate_Children): Add a renaming of
counter Busy and increment it. Update the return aggregate.
(Iterate_Subtree): Add a renaming of counter Busy and increment
it. Update the return aggregate.
* a-cdlili.ads, a-cidlli.ads: Type List_Access is now a general access
type.
* a-cihama.ads: Type Map_Access is now a general access type.
* a-comutr.ads, a-cimutr.ads: Use type Natural for the two locks
associated with the tree.
* a-cohama.ads: Type Map_Access is now a general access type.
* a-coinve.ads, a-convec.ads: Type Vector_Access is now a general
access type.
* exp_ch5.adb (Expand_Iterator_Loop): Do not create a block
to wrap the loop as this is done at an earlier step, during
analysis. The declarations of the iterator and the cursor use
the usual Insert_Action mechanism when added into the tree.
* sem_ch5.adb (Analyze_Loop_Statement): Remove local constant
Loop_Statement and replace all respective uses by N. Add local
constant Loc. Preanalyze the loop iterator to discover whether
it is a container iterator and if it is, wrap the loop in a
block. This ensures that any controlled temporaries produced
by the iteration scheme share the same lifetime of the loop.
(Is_Container_Iterator): New routine.
(Is_Wrapped_In_Block): New routine.
(Pre_Analyze_Range): Move spec and body to the library level.
2011-11-23 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi, vms_data.ads: Add documentation for new gnatpp option
that controls casing of type and subtype names.
2011-11-23 Yannick Moy <moy@adacore.com>
* sem_ch3.adb: Minor addition of comments.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* prj-part.adb (Extension_Withs): New global variable,
contains the head of the list of WITH clauses from the EXTENDS
ALL projects for which virtual packages are being created.
(Look_For_Virtual_Projects_For): When recursing through
an EXTENDS ALL, add the WITH clauses of the extending
project to Extension_Withs. When adding a project to the
Virtual_Hash, record the associated Extension_Withs list.
(Create_Virtual_Extending_Project): Add a copy of the appropriate
Extension_Withs to the virtual project.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* mlib-tgt-specific-vxworks.adb: Minor reformatting.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* Make-generated.in (Sdefault.Target_Name): Set to
$(target_noncanonical) instead of $(target) for consistency.
From-SVN: r181668
2011-11-23 14:51:23 +01:00
|
|
|
end record;
|
|
|
|
|
|
|
|
overriding procedure Finalize (Object : in out Iterator);
|
2011-08-29 16:19:32 +02:00
|
|
|
|
|
|
|
overriding function First (Object : Iterator) return Cursor;
|
|
|
|
overriding function Last (Object : Iterator) return Cursor;
|
|
|
|
|
|
|
|
overriding function Next
|
|
|
|
(Object : Iterator;
|
|
|
|
Position : Cursor) return Cursor;
|
|
|
|
|
|
|
|
overriding function Previous
|
|
|
|
(Object : Iterator;
|
|
|
|
Position : Cursor) return Cursor;
|
|
|
|
|
2010-10-25 15:50:29 +02:00
|
|
|
-----------------------
|
|
|
|
-- Local Subprograms --
|
|
|
|
-----------------------
|
|
|
|
|
|
|
|
function To_Array_Index (Index : Index_Type'Base) return Count_Type'Base;
|
|
|
|
|
|
|
|
---------
|
|
|
|
-- "&" --
|
|
|
|
---------
|
|
|
|
|
|
|
|
function "&" (Left, Right : Vector) return Vector is
|
|
|
|
LN : constant Count_Type := Length (Left);
|
|
|
|
RN : constant Count_Type := Length (Right);
|
|
|
|
N : Count_Type'Base; -- length of result
|
|
|
|
J : Count_Type'Base; -- for computing intermediate index values
|
|
|
|
Last : Index_Type'Base; -- Last index of result
|
|
|
|
|
|
|
|
begin
|
|
|
|
-- We decide that the capacity of the result is the sum of the lengths
|
|
|
|
-- of the vector parameters. We could decide to make it larger, but we
|
|
|
|
-- have no basis for knowing how much larger, so we just allocate the
|
|
|
|
-- minimum amount of storage.
|
|
|
|
|
|
|
|
-- Here we handle the easy cases first, when one of the vector
|
|
|
|
-- parameters is empty. (We say "easy" because there's nothing to
|
|
|
|
-- compute, that can potentially overflow.)
|
|
|
|
|
|
|
|
if LN = 0 then
|
|
|
|
if RN = 0 then
|
|
|
|
return Empty_Vector;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return Vector'(Capacity => RN,
|
|
|
|
Elements => Right.Elements (1 .. RN),
|
|
|
|
Last => Right.Last,
|
|
|
|
others => <>);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if RN = 0 then
|
|
|
|
return Vector'(Capacity => LN,
|
|
|
|
Elements => Left.Elements (1 .. LN),
|
|
|
|
Last => Left.Last,
|
|
|
|
others => <>);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- Neither of the vector parameters is empty, so must compute the length
|
|
|
|
-- of the result vector and its last index. (This is the harder case,
|
|
|
|
-- because our computations must avoid overflow.)
|
|
|
|
|
|
|
|
-- There are two constraints we need to satisfy. The first constraint is
|
|
|
|
-- that a container cannot have more than Count_Type'Last elements, so
|
|
|
|
-- we must check the sum of the combined lengths. Note that we cannot
|
Fix typos in gcc/ada.
gcc/ada/:
* projects.texi: Fix typos.
* gnat_rm.texi: Likewise.
* gnat_ugn.texi: Likewise.
* sem_util.adb: Fix typo in variable, typos in comments.
* a-btgbso.adb: Fix typos in comments.
* a-cbdlli.adb, a-cbhase.ads, a-cdlili.adb, a-cobove.adb,
a-coinve.adb, a-convec.adb, a-direct.ads, a-strunb-shared.adb,
a-strunb-shared.ads, a-stuten.ads, a-stwiun-shared.adb,
a-stwiun-shared.ads, a-stzunb-shared.adb, a-stzunb-shared.ads,
a-suenco.adb, a-suenst.adb, a-suewst.adb, a-suezst.adb, ali.ads,
aspects.ads, atree.ads, binde.adb, bindgen.adb, checks.adb,
checks.ads, einfo.ads, err_vars.ads, errout.adb, errout.ads,
exp_aggr.adb, exp_attr.adb, exp_cg.adb, exp_ch3.adb,
exp_ch4.adb, exp_ch5.adb, exp_ch6.adb, exp_ch7.adb,
exp_dbug.ads, exp_disp.adb, exp_fixd.ads, freeze.adb,
g-altive.ads, g-comlin.ads, g-excact.ads, g-mbdira.adb,
g-sechas.ads, g-sehash.ads, g-sha1.ads, g-sha224.ads,
g-sha256.ads, g-sha384.ads, g-sha512.ads, g-shsh32.ads,
g-shsh64.ads, g-socket.adb, g-socket.ads, g-sothco.ads,
gcc-interface/decl.c, gcc-interface/trans.c,
gcc-interface/utils2.c, gnat1drv.adb, init.c, inline.adb,
link.c, locales.c, make.adb, mingw32.h, namet.ads, osint.adb,
par-ch12.adb, par-ch13.adb, par-ch3.adb, par-ch4.adb,
par-prag.adb, par.adb, par_sco.adb, prepcomp.adb,
prj-conf.ads, prj-dect.adb, prj-env.adb, prj-env.ads,
prj-nmsc.adb, prj-tree.ads, prj-util.ads, prj.adb, prj.ads,
s-auxdec-vms-alpha.adb, s-auxdec-vms_64.ads, s-oscons-tmplt.c,
s-osinte-vxworks.ads, s-osprim-mingw.adb, s-regexp.adb,
s-stusta.adb, s-taprop-mingw.adb, s-taprop-solaris.adb,
scn.adb, scos.ads, sem.adb, sem_aggr.adb, sem_attr.adb,
sem_aux.adb, sem_aux.ads, sem_ch12.adb, sem_ch12.ads,
sem_ch13.adb, sem_ch13.ads, sem_ch3.adb, sem_ch4.adb,
sem_ch6.adb, sem_ch7.adb, sem_ch8.adb, sem_disp.adb,
sem_disp.ads, sem_eval.adb, sem_intr.adb, sem_prag.adb,
sem_res.adb, sem_scil.adb, sem_util.ads, sem_warn.adb,
sem_warn.ads, sinfo.ads, socket.c, styleg.adb, switch.ads,
sysdep.c, tb-alvxw.c, xoscons.adb: Likewise.
From-SVN: r168082
2010-12-20 08:26:57 +01:00
|
|
|
-- simply add the lengths, because of the possibility of overflow.
|
2010-10-25 15:50:29 +02:00
|
|
|
|
|
|
|
if LN > Count_Type'Last - RN then
|
|
|
|
raise Constraint_Error with "new length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- It is now safe compute the length of the new vector, without fear of
|
|
|
|
-- overflow.
|
|
|
|
|
|
|
|
N := LN + RN;
|
|
|
|
|
|
|
|
-- The second constraint is that the new Last index value cannot
|
|
|
|
-- exceed Index_Type'Last. We use the wider of Index_Type'Base and
|
|
|
|
-- Count_Type'Base as the type for intermediate values.
|
|
|
|
|
|
|
|
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
|
|
|
-- We perform a two-part test. First we determine whether the
|
|
|
|
-- computed Last value lies in the base range of the type, and then
|
|
|
|
-- determine whether it lies in the range of the index (sub)type.
|
|
|
|
|
|
|
|
-- Last must satisfy this relation:
|
|
|
|
-- First + Length - 1 <= Last
|
|
|
|
-- We regroup terms:
|
|
|
|
-- First - 1 <= Last - Length
|
|
|
|
-- Which can rewrite as:
|
|
|
|
-- No_Index <= Last - Length
|
|
|
|
|
|
|
|
if Index_Type'Base'Last - Index_Type'Base (N) < No_Index then
|
|
|
|
raise Constraint_Error with "new length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We now know that the computed value of Last is within the base
|
|
|
|
-- range of the type, so it is safe to compute its value:
|
|
|
|
|
|
|
|
Last := No_Index + Index_Type'Base (N);
|
|
|
|
|
|
|
|
-- Finally we test whether the value is within the range of the
|
|
|
|
-- generic actual index subtype:
|
|
|
|
|
|
|
|
if Last > Index_Type'Last then
|
|
|
|
raise Constraint_Error with "new length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
elsif Index_Type'First <= 0 then
|
|
|
|
-- Here we can compute Last directly, in the normal way. We know that
|
|
|
|
-- No_Index is less than 0, so there is no danger of overflow when
|
|
|
|
-- adding the (positive) value of length.
|
|
|
|
|
|
|
|
J := Count_Type'Base (No_Index) + N; -- Last
|
|
|
|
|
|
|
|
if J > Count_Type'Base (Index_Type'Last) then
|
|
|
|
raise Constraint_Error with "new length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We know that the computed value (having type Count_Type) of Last
|
|
|
|
-- is within the range of the generic actual index subtype, so it is
|
|
|
|
-- safe to convert to Index_Type:
|
|
|
|
|
|
|
|
Last := Index_Type'Base (J);
|
|
|
|
|
|
|
|
else
|
|
|
|
-- Here Index_Type'First (and Index_Type'Last) is positive, so we
|
|
|
|
-- must test the length indirectly (by working backwards from the
|
|
|
|
-- largest possible value of Last), in order to prevent overflow.
|
|
|
|
|
|
|
|
J := Count_Type'Base (Index_Type'Last) - N; -- No_Index
|
|
|
|
|
|
|
|
if J < Count_Type'Base (No_Index) then
|
|
|
|
raise Constraint_Error with "new length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We have determined that the result length would not create a Last
|
|
|
|
-- index value outside of the range of Index_Type, so we can now
|
|
|
|
-- safely compute its value.
|
|
|
|
|
|
|
|
Last := Index_Type'Base (Count_Type'Base (No_Index) + N);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
declare
|
|
|
|
LE : Elements_Array renames Left.Elements (1 .. LN);
|
|
|
|
RE : Elements_Array renames Right.Elements (1 .. RN);
|
|
|
|
|
|
|
|
begin
|
|
|
|
return Vector'(Capacity => N,
|
|
|
|
Elements => LE & RE,
|
|
|
|
Last => Last,
|
|
|
|
others => <>);
|
|
|
|
end;
|
|
|
|
end "&";
|
|
|
|
|
|
|
|
function "&" (Left : Vector; Right : Element_Type) return Vector is
|
|
|
|
LN : constant Count_Type := Length (Left);
|
|
|
|
|
|
|
|
begin
|
|
|
|
-- We decide that the capacity of the result is the sum of the lengths
|
|
|
|
-- of the parameters. We could decide to make it larger, but we have no
|
|
|
|
-- basis for knowing how much larger, so we just allocate the minimum
|
|
|
|
-- amount of storage.
|
|
|
|
|
|
|
|
-- We must compute the length of the result vector and its last index,
|
|
|
|
-- but in such a way that overflow is avoided. We must satisfy two
|
|
|
|
-- constraints: the new length cannot exceed Count_Type'Last, and the
|
|
|
|
-- new Last index cannot exceed Index_Type'Last.
|
|
|
|
|
|
|
|
if LN = Count_Type'Last then
|
|
|
|
raise Constraint_Error with "new length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Left.Last >= Index_Type'Last then
|
|
|
|
raise Constraint_Error with "new length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return Vector'(Capacity => LN + 1,
|
|
|
|
Elements => Left.Elements (1 .. LN) & Right,
|
|
|
|
Last => Left.Last + 1,
|
|
|
|
others => <>);
|
|
|
|
end "&";
|
|
|
|
|
|
|
|
function "&" (Left : Element_Type; Right : Vector) return Vector is
|
|
|
|
RN : constant Count_Type := Length (Right);
|
|
|
|
|
|
|
|
begin
|
|
|
|
-- We decide that the capacity of the result is the sum of the lengths
|
|
|
|
-- of the parameters. We could decide to make it larger, but we have no
|
|
|
|
-- basis for knowing how much larger, so we just allocate the minimum
|
|
|
|
-- amount of storage.
|
|
|
|
|
|
|
|
-- We compute the length of the result vector and its last index, but in
|
|
|
|
-- such a way that overflow is avoided. We must satisfy two constraints:
|
|
|
|
-- the new length cannot exceed Count_Type'Last, and the new Last index
|
|
|
|
-- cannot exceed Index_Type'Last.
|
|
|
|
|
|
|
|
if RN = Count_Type'Last then
|
|
|
|
raise Constraint_Error with "new length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Right.Last >= Index_Type'Last then
|
|
|
|
raise Constraint_Error with "new length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return Vector'(Capacity => 1 + RN,
|
|
|
|
Elements => Left & Right.Elements (1 .. RN),
|
|
|
|
Last => Right.Last + 1,
|
|
|
|
others => <>);
|
|
|
|
end "&";
|
|
|
|
|
|
|
|
function "&" (Left, Right : Element_Type) return Vector is
|
|
|
|
begin
|
|
|
|
-- We decide that the capacity of the result is the sum of the lengths
|
|
|
|
-- of the parameters. We could decide to make it larger, but we have no
|
|
|
|
-- basis for knowing how much larger, so we just allocate the minimum
|
|
|
|
-- amount of storage.
|
|
|
|
|
|
|
|
-- We must compute the length of the result vector and its last index,
|
|
|
|
-- but in such a way that overflow is avoided. We must satisfy two
|
|
|
|
-- constraints: the new length cannot exceed Count_Type'Last (here, we
|
|
|
|
-- know that that condition is satisfied), and the new Last index cannot
|
|
|
|
-- exceed Index_Type'Last.
|
|
|
|
|
|
|
|
if Index_Type'First >= Index_Type'Last then
|
|
|
|
raise Constraint_Error with "new length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return Vector'(Capacity => 2,
|
|
|
|
Elements => (Left, Right),
|
|
|
|
Last => Index_Type'First + 1,
|
|
|
|
others => <>);
|
|
|
|
end "&";
|
|
|
|
|
|
|
|
---------
|
|
|
|
-- "=" --
|
|
|
|
---------
|
|
|
|
|
|
|
|
overriding function "=" (Left, Right : Vector) return Boolean is
|
|
|
|
begin
|
|
|
|
if Left'Address = Right'Address then
|
|
|
|
return True;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Left.Last /= Right.Last then
|
|
|
|
return False;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
for J in Count_Type range 1 .. Left.Length loop
|
|
|
|
if Left.Elements (J) /= Right.Elements (J) then
|
|
|
|
return False;
|
|
|
|
end if;
|
|
|
|
end loop;
|
|
|
|
|
|
|
|
return True;
|
|
|
|
end "=";
|
|
|
|
|
|
|
|
------------
|
|
|
|
-- Assign --
|
|
|
|
------------
|
|
|
|
|
|
|
|
procedure Assign (Target : in out Vector; Source : Vector) is
|
|
|
|
begin
|
|
|
|
if Target'Address = Source'Address then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Target.Capacity < Source.Length then
|
|
|
|
raise Capacity_Error -- ???
|
|
|
|
with "Target capacity is less than Source length";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Target.Clear;
|
|
|
|
|
|
|
|
Target.Elements (1 .. Source.Length) :=
|
|
|
|
Source.Elements (1 .. Source.Length);
|
|
|
|
|
|
|
|
Target.Last := Source.Last;
|
|
|
|
end Assign;
|
|
|
|
|
|
|
|
------------
|
|
|
|
-- Append --
|
|
|
|
------------
|
|
|
|
|
|
|
|
procedure Append (Container : in out Vector; New_Item : Vector) is
|
|
|
|
begin
|
|
|
|
if New_Item.Is_Empty then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Container.Last >= Index_Type'Last then
|
|
|
|
raise Constraint_Error with "vector is already at its maximum length";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Container.Insert (Container.Last + 1, New_Item);
|
|
|
|
end Append;
|
|
|
|
|
|
|
|
procedure Append
|
|
|
|
(Container : in out Vector;
|
|
|
|
New_Item : Element_Type;
|
|
|
|
Count : Count_Type := 1)
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
if Count = 0 then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Container.Last >= Index_Type'Last then
|
|
|
|
raise Constraint_Error with "vector is already at its maximum length";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Container.Insert (Container.Last + 1, New_Item, Count);
|
|
|
|
end Append;
|
|
|
|
|
|
|
|
--------------
|
|
|
|
-- Capacity --
|
|
|
|
--------------
|
|
|
|
|
|
|
|
function Capacity (Container : Vector) return Count_Type is
|
|
|
|
begin
|
|
|
|
return Container.Elements'Length;
|
|
|
|
end Capacity;
|
|
|
|
|
|
|
|
-----------
|
|
|
|
-- Clear --
|
|
|
|
-----------
|
|
|
|
|
|
|
|
procedure Clear (Container : in out Vector) is
|
|
|
|
begin
|
|
|
|
if Container.Busy > 0 then
|
|
|
|
raise Program_Error with
|
|
|
|
"attempt to tamper with cursors (vector is busy)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Container.Last := No_Index;
|
|
|
|
end Clear;
|
|
|
|
|
[multiple changes]
2012-01-10 Pascal Obry <obry@adacore.com>
* prj-nmsc.adb (Check_Library_Attributes): Kill check for object/source
directories for aggregate libraries.
2012-01-10 Matthew Heaney <heaney@adacore.com>
* a-cdlili.adb, a-cdlili.ads, a-cihama.adb, a-cihama.ads, a-coinve.adb,
a-coinve.ads, a-ciorse.adb, a-ciorse.ads, a-coorma.adb, a-coorma.ads,
a-cborma.adb, a-cborma.ads, a-cidlli.adb, a-cidlli.ads, a-cimutr.adb,
a-cimutr.ads, a-cihase.adb, a-cihase.ads, a-cohama.adb, a-cohama.ads,
a-coorse.adb, a-coorse.ads, a-cbhama.adb, a-cbhama.ads, a-cborse.adb,
a-cborse.ads, a-comutr.adb, a-comutr.ads, a-ciorma.adb, a-cobove.adb,
a-ciorma.ads, a-cobove.ads, a-convec.adb, a-convec.ads, a-cohase.adb,
a-cohase.ads, a-cbdlli.adb, a-cbdlli.ads, a-cbmutr.adb, a-cbmutr.ads,
a-cbhase.adb, a-cbhase.ads (Reference, Constant_Reference): Declare
container parameter as aliased in/in out.
Code clean ups.
2012-01-10 Bob Duff <duff@adacore.com>
* s-os_lib.ads: Improve comment.
2012-01-10 Geert Bosch <bosch@adacore.com>
* s-gearop.adb (Forward_Eliminate): Avoid improper aliasing
for complex Scalar.
From-SVN: r183060
2012-01-10 12:06:44 +01:00
|
|
|
------------------------
|
|
|
|
-- Constant_Reference --
|
|
|
|
------------------------
|
|
|
|
|
|
|
|
function Constant_Reference
|
|
|
|
(Container : aliased Vector;
|
|
|
|
Position : Cursor) return Constant_Reference_Type
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
if Position.Container = null then
|
|
|
|
raise Constraint_Error with "Position cursor has no element";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Position.Container /= Container'Unrestricted_Access then
|
|
|
|
raise Program_Error with "Position cursor denotes wrong container";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Position.Index > Position.Container.Last then
|
|
|
|
raise Constraint_Error with "Position cursor is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
declare
|
|
|
|
A : Elements_Array renames Container.Elements;
|
|
|
|
I : constant Count_Type := To_Array_Index (Position.Index);
|
|
|
|
begin
|
|
|
|
return (Element => A (I)'Access);
|
|
|
|
end;
|
|
|
|
end Constant_Reference;
|
|
|
|
|
|
|
|
function Constant_Reference
|
|
|
|
(Container : aliased Vector;
|
|
|
|
Index : Index_Type) return Constant_Reference_Type
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
if Index > Container.Last then
|
|
|
|
raise Constraint_Error with "Index is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
declare
|
|
|
|
A : Elements_Array renames Container.Elements;
|
|
|
|
I : constant Count_Type := To_Array_Index (Index);
|
|
|
|
begin
|
|
|
|
return (Element => A (I)'Access);
|
|
|
|
end;
|
|
|
|
end Constant_Reference;
|
|
|
|
|
2010-10-25 15:50:29 +02:00
|
|
|
--------------
|
|
|
|
-- Contains --
|
|
|
|
--------------
|
|
|
|
|
|
|
|
function Contains
|
|
|
|
(Container : Vector;
|
|
|
|
Item : Element_Type) return Boolean
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
return Find_Index (Container, Item) /= No_Index;
|
|
|
|
end Contains;
|
|
|
|
|
|
|
|
----------
|
|
|
|
-- Copy --
|
|
|
|
----------
|
|
|
|
|
|
|
|
function Copy
|
|
|
|
(Source : Vector;
|
|
|
|
Capacity : Count_Type := 0) return Vector
|
|
|
|
is
|
|
|
|
C : Count_Type;
|
|
|
|
|
|
|
|
begin
|
|
|
|
if Capacity = 0 then
|
|
|
|
C := Source.Length;
|
|
|
|
|
|
|
|
elsif Capacity >= Source.Length then
|
|
|
|
C := Capacity;
|
|
|
|
|
|
|
|
else
|
|
|
|
raise Capacity_Error
|
|
|
|
with "Requested capacity is less than Source length";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return Target : Vector (C) do
|
|
|
|
Target.Elements (1 .. Source.Length) :=
|
|
|
|
Source.Elements (1 .. Source.Length);
|
|
|
|
|
|
|
|
Target.Last := Source.Last;
|
|
|
|
end return;
|
|
|
|
end Copy;
|
|
|
|
|
|
|
|
------------
|
|
|
|
-- Delete --
|
|
|
|
------------
|
|
|
|
|
|
|
|
procedure Delete
|
|
|
|
(Container : in out Vector;
|
|
|
|
Index : Extended_Index;
|
|
|
|
Count : Count_Type := 1)
|
|
|
|
is
|
|
|
|
Old_Last : constant Index_Type'Base := Container.Last;
|
|
|
|
Old_Len : constant Count_Type := Container.Length;
|
|
|
|
New_Last : Index_Type'Base;
|
|
|
|
Count2 : Count_Type'Base; -- count of items from Index to Old_Last
|
|
|
|
Off : Count_Type'Base; -- Index expressed as offset from IT'First
|
|
|
|
|
|
|
|
begin
|
|
|
|
-- Delete removes items from the vector, the number of which is the
|
|
|
|
-- minimum of the specified Count and the items (if any) that exist from
|
|
|
|
-- Index to Container.Last. There are no constraints on the specified
|
|
|
|
-- value of Count (it can be larger than what's available at this
|
|
|
|
-- position in the vector, for example), but there are constraints on
|
|
|
|
-- the allowed values of the Index.
|
|
|
|
|
|
|
|
-- As a precondition on the generic actual Index_Type, the base type
|
|
|
|
-- must include Index_Type'Pred (Index_Type'First); this is the value
|
|
|
|
-- that Container.Last assumes when the vector is empty. However, we do
|
|
|
|
-- not allow that as the value for Index when specifying which items
|
|
|
|
-- should be deleted, so we must manually check. (That the user is
|
|
|
|
-- allowed to specify the value at all here is a consequence of the
|
|
|
|
-- declaration of the Extended_Index subtype, which includes the values
|
|
|
|
-- in the base range that immediately precede and immediately follow the
|
|
|
|
-- values in the Index_Type.)
|
|
|
|
|
|
|
|
if Index < Index_Type'First then
|
|
|
|
raise Constraint_Error with "Index is out of range (too small)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We do allow a value greater than Container.Last to be specified as
|
|
|
|
-- the Index, but only if it's immediately greater. This allows the
|
|
|
|
-- corner case of deleting no items from the back end of the vector to
|
|
|
|
-- be treated as a no-op. (It is assumed that specifying an index value
|
|
|
|
-- greater than Last + 1 indicates some deeper flaw in the caller's
|
|
|
|
-- algorithm, so that case is treated as a proper error.)
|
|
|
|
|
|
|
|
if Index > Old_Last then
|
|
|
|
if Index > Old_Last + 1 then
|
|
|
|
raise Constraint_Error with "Index is out of range (too large)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- Here and elsewhere we treat deleting 0 items from the container as a
|
|
|
|
-- no-op, even when the container is busy, so we simply return.
|
|
|
|
|
|
|
|
if Count = 0 then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- The tampering bits exist to prevent an item from being deleted (or
|
|
|
|
-- otherwise harmfully manipulated) while it is being visited. Query,
|
|
|
|
-- Update, and Iterate increment the busy count on entry, and decrement
|
|
|
|
-- the count on exit. Delete checks the count to determine whether it is
|
|
|
|
-- being called while the associated callback procedure is executing.
|
|
|
|
|
|
|
|
if Container.Busy > 0 then
|
|
|
|
raise Program_Error with
|
|
|
|
"attempt to tamper with cursors (vector is busy)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We first calculate what's available for deletion starting at
|
|
|
|
-- Index. Here and elsewhere we use the wider of Index_Type'Base and
|
|
|
|
-- Count_Type'Base as the type for intermediate values. (See function
|
|
|
|
-- Length for more information.)
|
|
|
|
|
|
|
|
if Count_Type'Base'Last >= Index_Type'Pos (Index_Type'Base'Last) then
|
|
|
|
Count2 := Count_Type'Base (Old_Last) - Count_Type'Base (Index) + 1;
|
|
|
|
|
|
|
|
else
|
|
|
|
Count2 := Count_Type'Base (Old_Last - Index + 1);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- If more elements are requested (Count) for deletion than are
|
|
|
|
-- available (Count2) for deletion beginning at Index, then everything
|
|
|
|
-- from Index is deleted. There are no elements to slide down, and so
|
|
|
|
-- all we need to do is set the value of Container.Last.
|
|
|
|
|
|
|
|
if Count >= Count2 then
|
|
|
|
Container.Last := Index - 1;
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- There are some elements aren't being deleted (the requested count was
|
|
|
|
-- less than the available count), so we must slide them down to
|
|
|
|
-- Index. We first calculate the index values of the respective array
|
|
|
|
-- slices, using the wider of Index_Type'Base and Count_Type'Base as the
|
|
|
|
-- type for intermediate calculations.
|
|
|
|
|
|
|
|
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
|
|
|
Off := Count_Type'Base (Index - Index_Type'First);
|
|
|
|
New_Last := Old_Last - Index_Type'Base (Count);
|
|
|
|
|
|
|
|
else
|
|
|
|
Off := Count_Type'Base (Index) - Count_Type'Base (Index_Type'First);
|
|
|
|
New_Last := Index_Type'Base (Count_Type'Base (Old_Last) - Count);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- The array index values for each slice have already been determined,
|
|
|
|
-- so we just slide down to Index the elements that weren't deleted.
|
|
|
|
|
|
|
|
declare
|
|
|
|
EA : Elements_Array renames Container.Elements;
|
|
|
|
Idx : constant Count_Type := EA'First + Off;
|
|
|
|
|
|
|
|
begin
|
|
|
|
EA (Idx .. Old_Len - Count) := EA (Idx + Count .. Old_Len);
|
|
|
|
Container.Last := New_Last;
|
|
|
|
end;
|
|
|
|
end Delete;
|
|
|
|
|
|
|
|
procedure Delete
|
|
|
|
(Container : in out Vector;
|
|
|
|
Position : in out Cursor;
|
|
|
|
Count : Count_Type := 1)
|
|
|
|
is
|
|
|
|
pragma Warnings (Off, Position);
|
|
|
|
|
|
|
|
begin
|
|
|
|
if Position.Container = null then
|
|
|
|
raise Constraint_Error with "Position cursor has no element";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Position.Container /= Container'Unrestricted_Access then
|
|
|
|
raise Program_Error with "Position cursor denotes wrong container";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Position.Index > Container.Last then
|
|
|
|
raise Program_Error with "Position index is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Delete (Container, Position.Index, Count);
|
|
|
|
Position := No_Element;
|
|
|
|
end Delete;
|
|
|
|
|
|
|
|
------------------
|
|
|
|
-- Delete_First --
|
|
|
|
------------------
|
|
|
|
|
|
|
|
procedure Delete_First
|
|
|
|
(Container : in out Vector;
|
|
|
|
Count : Count_Type := 1)
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
if Count = 0 then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Count >= Length (Container) then
|
|
|
|
Clear (Container);
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Delete (Container, Index_Type'First, Count);
|
|
|
|
end Delete_First;
|
|
|
|
|
|
|
|
-----------------
|
|
|
|
-- Delete_Last --
|
|
|
|
-----------------
|
|
|
|
|
|
|
|
procedure Delete_Last
|
|
|
|
(Container : in out Vector;
|
|
|
|
Count : Count_Type := 1)
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
-- It is not permitted to delete items while the container is busy (for
|
|
|
|
-- example, we're in the middle of a passive iteration). However, we
|
|
|
|
-- always treat deleting 0 items as a no-op, even when we're busy, so we
|
|
|
|
-- simply return without checking.
|
|
|
|
|
|
|
|
if Count = 0 then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- The tampering bits exist to prevent an item from being deleted (or
|
|
|
|
-- otherwise harmfully manipulated) while it is being visited. Query,
|
|
|
|
-- Update, and Iterate increment the busy count on entry, and decrement
|
|
|
|
-- the count on exit. Delete_Last checks the count to determine whether
|
|
|
|
-- it is being called while the associated callback procedure is
|
|
|
|
-- executing.
|
|
|
|
|
|
|
|
if Container.Busy > 0 then
|
|
|
|
raise Program_Error with
|
|
|
|
"attempt to tamper with cursors (vector is busy)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- There is no restriction on how large Count can be when deleting
|
|
|
|
-- items. If it is equal or greater than the current length, then this
|
|
|
|
-- is equivalent to clearing the vector. (In particular, there's no need
|
|
|
|
-- for us to actually calculate the new value for Last.)
|
|
|
|
|
|
|
|
-- If the requested count is less than the current length, then we must
|
|
|
|
-- calculate the new value for Last. For the type we use the widest of
|
|
|
|
-- Index_Type'Base and Count_Type'Base for the intermediate values of
|
|
|
|
-- our calculation. (See the comments in Length for more information.)
|
|
|
|
|
|
|
|
if Count >= Container.Length then
|
|
|
|
Container.Last := No_Index;
|
|
|
|
|
|
|
|
elsif Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
|
|
|
Container.Last := Container.Last - Index_Type'Base (Count);
|
|
|
|
|
|
|
|
else
|
|
|
|
Container.Last :=
|
|
|
|
Index_Type'Base (Count_Type'Base (Container.Last) - Count);
|
|
|
|
end if;
|
|
|
|
end Delete_Last;
|
|
|
|
|
|
|
|
-------------
|
|
|
|
-- Element --
|
|
|
|
-------------
|
|
|
|
|
|
|
|
function Element
|
|
|
|
(Container : Vector;
|
|
|
|
Index : Index_Type) return Element_Type
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
if Index > Container.Last then
|
|
|
|
raise Constraint_Error with "Index is out of range";
|
[multiple changes]
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
package spec.
* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
while raising PE.
From-SVN: r178245
2011-08-29 16:25:19 +02:00
|
|
|
else
|
|
|
|
return Container.Elements (To_Array_Index (Index));
|
2010-10-25 15:50:29 +02:00
|
|
|
end if;
|
|
|
|
end Element;
|
|
|
|
|
|
|
|
function Element (Position : Cursor) return Element_Type is
|
|
|
|
begin
|
|
|
|
if Position.Container = null then
|
|
|
|
raise Constraint_Error with "Position cursor has no element";
|
[multiple changes]
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
package spec.
* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
while raising PE.
From-SVN: r178245
2011-08-29 16:25:19 +02:00
|
|
|
else
|
|
|
|
return Position.Container.Element (Position.Index);
|
2010-10-25 15:50:29 +02:00
|
|
|
end if;
|
|
|
|
end Element;
|
|
|
|
|
[multiple changes]
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Freeze_All_Ent): An incomplete type is not
frozen by a subprogram body that does not come from source.
2011-11-23 Pascal Obry <obry@adacore.com>
* s-oscons-tmplt.c: Add PTY_Library constant. It contains
the library for pseudo terminal support.
* g-exptty.ads: Add pseudo-terminal library into a Linker_Options
pragma.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch9.adb: No check on entry family index if generic.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* sem_ch9.adb, s-taprop.ads, s-taprop-hpux-dce.adb, s-taprop-irix.adb,
s-taprop-posix.adb, s-taprop-rtx.adb, s-taprop-solaris.adb,
s-taprop-tru64.adb, s-taprop-vxworks.adb: Move dependency on
System.OS_Constants from shared spec of
System.Tasking.Primitive_Operations to the specific body variants
that really require this dependency.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming_Declaration):
If the declaration has aspects, analyze them so they can be
properly rejected.
2011-11-23 Hristian Kirtchev <kirtchev@adacore.com>
* a-comutr.adb, a-coorma.adb, a-coorse.adb, a-convec.adb, a-cihase.adb,
a-cimutr.adb, a-coinve.adb, a-ciorma.adb, a-ciorse.adb, a-cobove.adb,
a-cohama.adb, a-cihama.adb, a-cidlli.adb, a-cdlili.adb, a-cbhama.adb,
a-cbhase.adb, a-cbmutr.adb, a-cborma.adb, a-cborse.adb, a-cbdlli.adb:
Add with and use clause for Ada.Finalization. Type
Iterator and Child_Iterator are now derived from Limited_Controlled.
(Finalize): New routine.
(Iterate): Add a renaming of counter Busy and
increment it. Update the return aggregate.
(Iterate_Children): Add a renaming of
counter Busy and increment it. Update the return aggregate.
(Iterate_Subtree): Add a renaming of counter Busy and increment
it. Update the return aggregate.
* a-cdlili.ads, a-cidlli.ads: Type List_Access is now a general access
type.
* a-cihama.ads: Type Map_Access is now a general access type.
* a-comutr.ads, a-cimutr.ads: Use type Natural for the two locks
associated with the tree.
* a-cohama.ads: Type Map_Access is now a general access type.
* a-coinve.ads, a-convec.ads: Type Vector_Access is now a general
access type.
* exp_ch5.adb (Expand_Iterator_Loop): Do not create a block
to wrap the loop as this is done at an earlier step, during
analysis. The declarations of the iterator and the cursor use
the usual Insert_Action mechanism when added into the tree.
* sem_ch5.adb (Analyze_Loop_Statement): Remove local constant
Loop_Statement and replace all respective uses by N. Add local
constant Loc. Preanalyze the loop iterator to discover whether
it is a container iterator and if it is, wrap the loop in a
block. This ensures that any controlled temporaries produced
by the iteration scheme share the same lifetime of the loop.
(Is_Container_Iterator): New routine.
(Is_Wrapped_In_Block): New routine.
(Pre_Analyze_Range): Move spec and body to the library level.
2011-11-23 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi, vms_data.ads: Add documentation for new gnatpp option
that controls casing of type and subtype names.
2011-11-23 Yannick Moy <moy@adacore.com>
* sem_ch3.adb: Minor addition of comments.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* prj-part.adb (Extension_Withs): New global variable,
contains the head of the list of WITH clauses from the EXTENDS
ALL projects for which virtual packages are being created.
(Look_For_Virtual_Projects_For): When recursing through
an EXTENDS ALL, add the WITH clauses of the extending
project to Extension_Withs. When adding a project to the
Virtual_Hash, record the associated Extension_Withs list.
(Create_Virtual_Extending_Project): Add a copy of the appropriate
Extension_Withs to the virtual project.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* mlib-tgt-specific-vxworks.adb: Minor reformatting.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* Make-generated.in (Sdefault.Target_Name): Set to
$(target_noncanonical) instead of $(target) for consistency.
From-SVN: r181668
2011-11-23 14:51:23 +01:00
|
|
|
--------------
|
|
|
|
-- Finalize --
|
|
|
|
--------------
|
|
|
|
|
|
|
|
procedure Finalize (Object : in out Iterator) is
|
2011-12-12 12:28:03 +01:00
|
|
|
B : Natural renames Object.Container.Busy;
|
[multiple changes]
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Freeze_All_Ent): An incomplete type is not
frozen by a subprogram body that does not come from source.
2011-11-23 Pascal Obry <obry@adacore.com>
* s-oscons-tmplt.c: Add PTY_Library constant. It contains
the library for pseudo terminal support.
* g-exptty.ads: Add pseudo-terminal library into a Linker_Options
pragma.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch9.adb: No check on entry family index if generic.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* sem_ch9.adb, s-taprop.ads, s-taprop-hpux-dce.adb, s-taprop-irix.adb,
s-taprop-posix.adb, s-taprop-rtx.adb, s-taprop-solaris.adb,
s-taprop-tru64.adb, s-taprop-vxworks.adb: Move dependency on
System.OS_Constants from shared spec of
System.Tasking.Primitive_Operations to the specific body variants
that really require this dependency.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming_Declaration):
If the declaration has aspects, analyze them so they can be
properly rejected.
2011-11-23 Hristian Kirtchev <kirtchev@adacore.com>
* a-comutr.adb, a-coorma.adb, a-coorse.adb, a-convec.adb, a-cihase.adb,
a-cimutr.adb, a-coinve.adb, a-ciorma.adb, a-ciorse.adb, a-cobove.adb,
a-cohama.adb, a-cihama.adb, a-cidlli.adb, a-cdlili.adb, a-cbhama.adb,
a-cbhase.adb, a-cbmutr.adb, a-cborma.adb, a-cborse.adb, a-cbdlli.adb:
Add with and use clause for Ada.Finalization. Type
Iterator and Child_Iterator are now derived from Limited_Controlled.
(Finalize): New routine.
(Iterate): Add a renaming of counter Busy and
increment it. Update the return aggregate.
(Iterate_Children): Add a renaming of
counter Busy and increment it. Update the return aggregate.
(Iterate_Subtree): Add a renaming of counter Busy and increment
it. Update the return aggregate.
* a-cdlili.ads, a-cidlli.ads: Type List_Access is now a general access
type.
* a-cihama.ads: Type Map_Access is now a general access type.
* a-comutr.ads, a-cimutr.ads: Use type Natural for the two locks
associated with the tree.
* a-cohama.ads: Type Map_Access is now a general access type.
* a-coinve.ads, a-convec.ads: Type Vector_Access is now a general
access type.
* exp_ch5.adb (Expand_Iterator_Loop): Do not create a block
to wrap the loop as this is done at an earlier step, during
analysis. The declarations of the iterator and the cursor use
the usual Insert_Action mechanism when added into the tree.
* sem_ch5.adb (Analyze_Loop_Statement): Remove local constant
Loop_Statement and replace all respective uses by N. Add local
constant Loc. Preanalyze the loop iterator to discover whether
it is a container iterator and if it is, wrap the loop in a
block. This ensures that any controlled temporaries produced
by the iteration scheme share the same lifetime of the loop.
(Is_Container_Iterator): New routine.
(Is_Wrapped_In_Block): New routine.
(Pre_Analyze_Range): Move spec and body to the library level.
2011-11-23 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi, vms_data.ads: Add documentation for new gnatpp option
that controls casing of type and subtype names.
2011-11-23 Yannick Moy <moy@adacore.com>
* sem_ch3.adb: Minor addition of comments.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* prj-part.adb (Extension_Withs): New global variable,
contains the head of the list of WITH clauses from the EXTENDS
ALL projects for which virtual packages are being created.
(Look_For_Virtual_Projects_For): When recursing through
an EXTENDS ALL, add the WITH clauses of the extending
project to Extension_Withs. When adding a project to the
Virtual_Hash, record the associated Extension_Withs list.
(Create_Virtual_Extending_Project): Add a copy of the appropriate
Extension_Withs to the virtual project.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* mlib-tgt-specific-vxworks.adb: Minor reformatting.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* Make-generated.in (Sdefault.Target_Name): Set to
$(target_noncanonical) instead of $(target) for consistency.
From-SVN: r181668
2011-11-23 14:51:23 +01:00
|
|
|
begin
|
2011-12-12 12:28:03 +01:00
|
|
|
B := B - 1;
|
[multiple changes]
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Freeze_All_Ent): An incomplete type is not
frozen by a subprogram body that does not come from source.
2011-11-23 Pascal Obry <obry@adacore.com>
* s-oscons-tmplt.c: Add PTY_Library constant. It contains
the library for pseudo terminal support.
* g-exptty.ads: Add pseudo-terminal library into a Linker_Options
pragma.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch9.adb: No check on entry family index if generic.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* sem_ch9.adb, s-taprop.ads, s-taprop-hpux-dce.adb, s-taprop-irix.adb,
s-taprop-posix.adb, s-taprop-rtx.adb, s-taprop-solaris.adb,
s-taprop-tru64.adb, s-taprop-vxworks.adb: Move dependency on
System.OS_Constants from shared spec of
System.Tasking.Primitive_Operations to the specific body variants
that really require this dependency.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming_Declaration):
If the declaration has aspects, analyze them so they can be
properly rejected.
2011-11-23 Hristian Kirtchev <kirtchev@adacore.com>
* a-comutr.adb, a-coorma.adb, a-coorse.adb, a-convec.adb, a-cihase.adb,
a-cimutr.adb, a-coinve.adb, a-ciorma.adb, a-ciorse.adb, a-cobove.adb,
a-cohama.adb, a-cihama.adb, a-cidlli.adb, a-cdlili.adb, a-cbhama.adb,
a-cbhase.adb, a-cbmutr.adb, a-cborma.adb, a-cborse.adb, a-cbdlli.adb:
Add with and use clause for Ada.Finalization. Type
Iterator and Child_Iterator are now derived from Limited_Controlled.
(Finalize): New routine.
(Iterate): Add a renaming of counter Busy and
increment it. Update the return aggregate.
(Iterate_Children): Add a renaming of
counter Busy and increment it. Update the return aggregate.
(Iterate_Subtree): Add a renaming of counter Busy and increment
it. Update the return aggregate.
* a-cdlili.ads, a-cidlli.ads: Type List_Access is now a general access
type.
* a-cihama.ads: Type Map_Access is now a general access type.
* a-comutr.ads, a-cimutr.ads: Use type Natural for the two locks
associated with the tree.
* a-cohama.ads: Type Map_Access is now a general access type.
* a-coinve.ads, a-convec.ads: Type Vector_Access is now a general
access type.
* exp_ch5.adb (Expand_Iterator_Loop): Do not create a block
to wrap the loop as this is done at an earlier step, during
analysis. The declarations of the iterator and the cursor use
the usual Insert_Action mechanism when added into the tree.
* sem_ch5.adb (Analyze_Loop_Statement): Remove local constant
Loop_Statement and replace all respective uses by N. Add local
constant Loc. Preanalyze the loop iterator to discover whether
it is a container iterator and if it is, wrap the loop in a
block. This ensures that any controlled temporaries produced
by the iteration scheme share the same lifetime of the loop.
(Is_Container_Iterator): New routine.
(Is_Wrapped_In_Block): New routine.
(Pre_Analyze_Range): Move spec and body to the library level.
2011-11-23 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi, vms_data.ads: Add documentation for new gnatpp option
that controls casing of type and subtype names.
2011-11-23 Yannick Moy <moy@adacore.com>
* sem_ch3.adb: Minor addition of comments.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* prj-part.adb (Extension_Withs): New global variable,
contains the head of the list of WITH clauses from the EXTENDS
ALL projects for which virtual packages are being created.
(Look_For_Virtual_Projects_For): When recursing through
an EXTENDS ALL, add the WITH clauses of the extending
project to Extension_Withs. When adding a project to the
Virtual_Hash, record the associated Extension_Withs list.
(Create_Virtual_Extending_Project): Add a copy of the appropriate
Extension_Withs to the virtual project.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* mlib-tgt-specific-vxworks.adb: Minor reformatting.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* Make-generated.in (Sdefault.Target_Name): Set to
$(target_noncanonical) instead of $(target) for consistency.
From-SVN: r181668
2011-11-23 14:51:23 +01:00
|
|
|
end Finalize;
|
|
|
|
|
2010-10-25 15:50:29 +02:00
|
|
|
----------
|
|
|
|
-- Find --
|
|
|
|
----------
|
|
|
|
|
|
|
|
function Find
|
|
|
|
(Container : Vector;
|
|
|
|
Item : Element_Type;
|
|
|
|
Position : Cursor := No_Element) return Cursor
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
if Position.Container /= null then
|
|
|
|
if Position.Container /= Container'Unrestricted_Access then
|
|
|
|
raise Program_Error with "Position cursor denotes wrong container";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Position.Index > Container.Last then
|
|
|
|
raise Program_Error with "Position index is out of range";
|
|
|
|
end if;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
for J in Position.Index .. Container.Last loop
|
|
|
|
if Container.Elements (To_Array_Index (J)) = Item then
|
|
|
|
return (Container'Unrestricted_Access, J);
|
|
|
|
end if;
|
|
|
|
end loop;
|
|
|
|
|
|
|
|
return No_Element;
|
|
|
|
end Find;
|
|
|
|
|
|
|
|
----------------
|
|
|
|
-- Find_Index --
|
|
|
|
----------------
|
|
|
|
|
|
|
|
function Find_Index
|
|
|
|
(Container : Vector;
|
|
|
|
Item : Element_Type;
|
|
|
|
Index : Index_Type := Index_Type'First) return Extended_Index
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
for Indx in Index .. Container.Last loop
|
|
|
|
if Container.Elements (To_Array_Index (Indx)) = Item then
|
|
|
|
return Indx;
|
|
|
|
end if;
|
|
|
|
end loop;
|
|
|
|
|
|
|
|
return No_Index;
|
|
|
|
end Find_Index;
|
|
|
|
|
|
|
|
-----------
|
|
|
|
-- First --
|
|
|
|
-----------
|
|
|
|
|
|
|
|
function First (Container : Vector) return Cursor is
|
|
|
|
begin
|
|
|
|
if Is_Empty (Container) then
|
|
|
|
return No_Element;
|
[multiple changes]
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
package spec.
* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
while raising PE.
From-SVN: r178245
2011-08-29 16:25:19 +02:00
|
|
|
else
|
|
|
|
return (Container'Unrestricted_Access, Index_Type'First);
|
2010-10-25 15:50:29 +02:00
|
|
|
end if;
|
|
|
|
end First;
|
|
|
|
|
2011-08-29 16:19:32 +02:00
|
|
|
function First (Object : Iterator) return Cursor is
|
|
|
|
begin
|
2011-12-12 12:28:03 +01:00
|
|
|
-- The value of the iterator object's Index component influences the
|
|
|
|
-- behavior of the First (and Last) selector function.
|
|
|
|
|
2011-12-12 12:52:04 +01:00
|
|
|
-- When the Index component is No_Index, this means the iterator
|
|
|
|
-- object was constructed without a start expression, in which case the
|
2011-12-12 12:28:03 +01:00
|
|
|
-- (forward) iteration starts from the (logical) beginning of the entire
|
|
|
|
-- sequence of items (corresponding to Container.First, for a forward
|
|
|
|
-- iterator).
|
|
|
|
|
2011-12-12 12:52:04 +01:00
|
|
|
-- Otherwise, this is iteration over a partial sequence of items.
|
|
|
|
-- When the Index component isn't No_Index, the iterator object was
|
|
|
|
-- constructed with a start expression, that specifies the position
|
|
|
|
-- from which the (forward) partial iteration begins.
|
2011-12-12 12:28:03 +01:00
|
|
|
|
|
|
|
if Object.Index = No_Index then
|
|
|
|
return First (Object.Container.all);
|
[multiple changes]
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
package spec.
* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
while raising PE.
From-SVN: r178245
2011-08-29 16:25:19 +02:00
|
|
|
else
|
2011-12-12 12:28:03 +01:00
|
|
|
return Cursor'(Object.Container, Object.Index);
|
2011-08-29 16:19:32 +02:00
|
|
|
end if;
|
|
|
|
end First;
|
|
|
|
|
2010-10-25 15:50:29 +02:00
|
|
|
-------------------
|
|
|
|
-- First_Element --
|
|
|
|
-------------------
|
|
|
|
|
|
|
|
function First_Element (Container : Vector) return Element_Type is
|
|
|
|
begin
|
|
|
|
if Container.Last = No_Index then
|
|
|
|
raise Constraint_Error with "Container is empty";
|
[multiple changes]
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
package spec.
* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
while raising PE.
From-SVN: r178245
2011-08-29 16:25:19 +02:00
|
|
|
else
|
|
|
|
return Container.Elements (To_Array_Index (Index_Type'First));
|
2010-10-25 15:50:29 +02:00
|
|
|
end if;
|
|
|
|
end First_Element;
|
|
|
|
|
|
|
|
-----------------
|
|
|
|
-- First_Index --
|
|
|
|
-----------------
|
|
|
|
|
|
|
|
function First_Index (Container : Vector) return Index_Type is
|
|
|
|
pragma Unreferenced (Container);
|
|
|
|
begin
|
|
|
|
return Index_Type'First;
|
|
|
|
end First_Index;
|
|
|
|
|
|
|
|
---------------------
|
|
|
|
-- Generic_Sorting --
|
|
|
|
---------------------
|
|
|
|
|
|
|
|
package body Generic_Sorting is
|
|
|
|
|
|
|
|
---------------
|
|
|
|
-- Is_Sorted --
|
|
|
|
---------------
|
|
|
|
|
|
|
|
function Is_Sorted (Container : Vector) return Boolean is
|
|
|
|
begin
|
|
|
|
if Container.Last <= Index_Type'First then
|
|
|
|
return True;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
declare
|
|
|
|
EA : Elements_Array renames Container.Elements;
|
|
|
|
begin
|
|
|
|
for J in 1 .. Container.Length - 1 loop
|
|
|
|
if EA (J + 1) < EA (J) then
|
|
|
|
return False;
|
|
|
|
end if;
|
|
|
|
end loop;
|
|
|
|
end;
|
|
|
|
|
|
|
|
return True;
|
|
|
|
end Is_Sorted;
|
|
|
|
|
|
|
|
-----------
|
|
|
|
-- Merge --
|
|
|
|
-----------
|
|
|
|
|
|
|
|
procedure Merge (Target, Source : in out Vector) is
|
|
|
|
I, J : Count_Type;
|
|
|
|
|
|
|
|
begin
|
2011-11-04 15:00:29 +01:00
|
|
|
|
|
|
|
-- The semantics of Merge changed slightly per AI05-0021. It was
|
|
|
|
-- originally the case that if Target and Source denoted the same
|
|
|
|
-- container object, then the GNAT implementation of Merge did
|
|
|
|
-- nothing. However, it was argued that RM05 did not precisely
|
|
|
|
-- specify the semantics for this corner case. The decision of the
|
|
|
|
-- ARG was that if Target and Source denote the same non-empty
|
|
|
|
-- container object, then Program_Error is raised.
|
|
|
|
|
|
|
|
if Source.Is_Empty then
|
2010-10-25 15:50:29 +02:00
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Target'Address = Source'Address then
|
2011-11-04 15:00:29 +01:00
|
|
|
raise Program_Error with
|
|
|
|
"Target and Source denote same non-empty container";
|
2010-10-25 15:50:29 +02:00
|
|
|
end if;
|
|
|
|
|
2011-11-04 15:00:29 +01:00
|
|
|
if Target.Is_Empty then
|
|
|
|
Move (Target => Target, Source => Source);
|
2010-10-25 15:50:29 +02:00
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Source.Busy > 0 then
|
|
|
|
raise Program_Error with
|
|
|
|
"attempt to tamper with cursors (vector is busy)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
I := Target.Length;
|
|
|
|
Target.Set_Length (I + Source.Length);
|
|
|
|
|
|
|
|
declare
|
|
|
|
TA : Elements_Array renames Target.Elements;
|
|
|
|
SA : Elements_Array renames Source.Elements;
|
|
|
|
|
|
|
|
begin
|
|
|
|
J := Target.Length;
|
|
|
|
while not Source.Is_Empty loop
|
|
|
|
pragma Assert (Source.Length <= 1
|
|
|
|
or else not (SA (Source.Length) <
|
|
|
|
SA (Source.Length - 1)));
|
|
|
|
|
|
|
|
if I = 0 then
|
|
|
|
TA (1 .. J) := SA (1 .. Source.Length);
|
|
|
|
Source.Last := No_Index;
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
pragma Assert (I <= 1
|
|
|
|
or else not (TA (I) < TA (I - 1)));
|
|
|
|
|
|
|
|
if SA (Source.Length) < TA (I) then
|
|
|
|
TA (J) := TA (I);
|
|
|
|
I := I - 1;
|
|
|
|
|
|
|
|
else
|
|
|
|
TA (J) := SA (Source.Length);
|
|
|
|
Source.Last := Source.Last - 1;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
J := J - 1;
|
|
|
|
end loop;
|
|
|
|
end;
|
|
|
|
end Merge;
|
|
|
|
|
|
|
|
----------
|
|
|
|
-- Sort --
|
|
|
|
----------
|
|
|
|
|
2012-01-30 13:16:12 +01:00
|
|
|
procedure Sort (Container : in out Vector) is
|
2010-10-25 15:50:29 +02:00
|
|
|
procedure Sort is
|
|
|
|
new Generic_Array_Sort
|
|
|
|
(Index_Type => Count_Type,
|
|
|
|
Element_Type => Element_Type,
|
|
|
|
Array_Type => Elements_Array,
|
|
|
|
"<" => "<");
|
|
|
|
|
|
|
|
begin
|
|
|
|
if Container.Last <= Index_Type'First then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
2012-01-30 13:16:12 +01:00
|
|
|
-- The exception behavior for the vector container must match that
|
|
|
|
-- for the list container, so we check for cursor tampering here
|
|
|
|
-- (which will catch more things) instead of for element tampering
|
|
|
|
-- (which will catch fewer things). It's true that the elements of
|
|
|
|
-- this vector container could be safely moved around while (say) an
|
|
|
|
-- iteration is taking place (iteration only increments the busy
|
|
|
|
-- counter), and so technically all we would need here is a test for
|
|
|
|
-- element tampering (indicated by the lock counter), that's simply
|
|
|
|
-- an artifact of our array-based implementation. Logically Sort
|
|
|
|
-- requires a check for cursor tampering.
|
|
|
|
|
|
|
|
if Container.Busy > 0 then
|
2010-10-25 15:50:29 +02:00
|
|
|
raise Program_Error with
|
2012-01-30 13:16:12 +01:00
|
|
|
"attempt to tamper with cursors (vector is busy)";
|
2010-10-25 15:50:29 +02:00
|
|
|
end if;
|
|
|
|
|
|
|
|
Sort (Container.Elements (1 .. Container.Length));
|
|
|
|
end Sort;
|
|
|
|
|
|
|
|
end Generic_Sorting;
|
|
|
|
|
|
|
|
-----------------
|
|
|
|
-- Has_Element --
|
|
|
|
-----------------
|
|
|
|
|
|
|
|
function Has_Element (Position : Cursor) return Boolean is
|
|
|
|
begin
|
|
|
|
if Position.Container = null then
|
|
|
|
return False;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return Position.Index <= Position.Container.Last;
|
|
|
|
end Has_Element;
|
|
|
|
|
|
|
|
------------
|
|
|
|
-- Insert --
|
|
|
|
------------
|
|
|
|
|
|
|
|
procedure Insert
|
|
|
|
(Container : in out Vector;
|
|
|
|
Before : Extended_Index;
|
|
|
|
New_Item : Element_Type;
|
|
|
|
Count : Count_Type := 1)
|
|
|
|
is
|
|
|
|
EA : Elements_Array renames Container.Elements;
|
|
|
|
Old_Length : constant Count_Type := Container.Length;
|
|
|
|
|
|
|
|
Max_Length : Count_Type'Base; -- determined from range of Index_Type
|
|
|
|
New_Length : Count_Type'Base; -- sum of current length and Count
|
|
|
|
|
|
|
|
Index : Index_Type'Base; -- scratch for intermediate values
|
|
|
|
J : Count_Type'Base; -- scratch
|
|
|
|
|
|
|
|
begin
|
|
|
|
-- As a precondition on the generic actual Index_Type, the base type
|
|
|
|
-- must include Index_Type'Pred (Index_Type'First); this is the value
|
|
|
|
-- that Container.Last assumes when the vector is empty. However, we do
|
|
|
|
-- not allow that as the value for Index when specifying where the new
|
|
|
|
-- items should be inserted, so we must manually check. (That the user
|
|
|
|
-- is allowed to specify the value at all here is a consequence of the
|
|
|
|
-- declaration of the Extended_Index subtype, which includes the values
|
|
|
|
-- in the base range that immediately precede and immediately follow the
|
|
|
|
-- values in the Index_Type.)
|
|
|
|
|
|
|
|
if Before < Index_Type'First then
|
|
|
|
raise Constraint_Error with
|
|
|
|
"Before index is out of range (too small)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We do allow a value greater than Container.Last to be specified as
|
|
|
|
-- the Index, but only if it's immediately greater. This allows for the
|
|
|
|
-- case of appending items to the back end of the vector. (It is assumed
|
|
|
|
-- that specifying an index value greater than Last + 1 indicates some
|
|
|
|
-- deeper flaw in the caller's algorithm, so that case is treated as a
|
|
|
|
-- proper error.)
|
|
|
|
|
|
|
|
if Before > Container.Last
|
|
|
|
and then Before > Container.Last + 1
|
|
|
|
then
|
|
|
|
raise Constraint_Error with
|
|
|
|
"Before index is out of range (too large)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We treat inserting 0 items into the container as a no-op, even when
|
|
|
|
-- the container is busy, so we simply return.
|
|
|
|
|
|
|
|
if Count = 0 then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- There are two constraints we need to satisfy. The first constraint is
|
|
|
|
-- that a container cannot have more than Count_Type'Last elements, so
|
|
|
|
-- we must check the sum of the current length and the insertion
|
|
|
|
-- count. Note that we cannot simply add these values, because of the
|
Fix typos in gcc/ada.
gcc/ada/:
* projects.texi: Fix typos.
* gnat_rm.texi: Likewise.
* gnat_ugn.texi: Likewise.
* sem_util.adb: Fix typo in variable, typos in comments.
* a-btgbso.adb: Fix typos in comments.
* a-cbdlli.adb, a-cbhase.ads, a-cdlili.adb, a-cobove.adb,
a-coinve.adb, a-convec.adb, a-direct.ads, a-strunb-shared.adb,
a-strunb-shared.ads, a-stuten.ads, a-stwiun-shared.adb,
a-stwiun-shared.ads, a-stzunb-shared.adb, a-stzunb-shared.ads,
a-suenco.adb, a-suenst.adb, a-suewst.adb, a-suezst.adb, ali.ads,
aspects.ads, atree.ads, binde.adb, bindgen.adb, checks.adb,
checks.ads, einfo.ads, err_vars.ads, errout.adb, errout.ads,
exp_aggr.adb, exp_attr.adb, exp_cg.adb, exp_ch3.adb,
exp_ch4.adb, exp_ch5.adb, exp_ch6.adb, exp_ch7.adb,
exp_dbug.ads, exp_disp.adb, exp_fixd.ads, freeze.adb,
g-altive.ads, g-comlin.ads, g-excact.ads, g-mbdira.adb,
g-sechas.ads, g-sehash.ads, g-sha1.ads, g-sha224.ads,
g-sha256.ads, g-sha384.ads, g-sha512.ads, g-shsh32.ads,
g-shsh64.ads, g-socket.adb, g-socket.ads, g-sothco.ads,
gcc-interface/decl.c, gcc-interface/trans.c,
gcc-interface/utils2.c, gnat1drv.adb, init.c, inline.adb,
link.c, locales.c, make.adb, mingw32.h, namet.ads, osint.adb,
par-ch12.adb, par-ch13.adb, par-ch3.adb, par-ch4.adb,
par-prag.adb, par.adb, par_sco.adb, prepcomp.adb,
prj-conf.ads, prj-dect.adb, prj-env.adb, prj-env.ads,
prj-nmsc.adb, prj-tree.ads, prj-util.ads, prj.adb, prj.ads,
s-auxdec-vms-alpha.adb, s-auxdec-vms_64.ads, s-oscons-tmplt.c,
s-osinte-vxworks.ads, s-osprim-mingw.adb, s-regexp.adb,
s-stusta.adb, s-taprop-mingw.adb, s-taprop-solaris.adb,
scn.adb, scos.ads, sem.adb, sem_aggr.adb, sem_attr.adb,
sem_aux.adb, sem_aux.ads, sem_ch12.adb, sem_ch12.ads,
sem_ch13.adb, sem_ch13.ads, sem_ch3.adb, sem_ch4.adb,
sem_ch6.adb, sem_ch7.adb, sem_ch8.adb, sem_disp.adb,
sem_disp.ads, sem_eval.adb, sem_intr.adb, sem_prag.adb,
sem_res.adb, sem_scil.adb, sem_util.ads, sem_warn.adb,
sem_warn.ads, sinfo.ads, socket.c, styleg.adb, switch.ads,
sysdep.c, tb-alvxw.c, xoscons.adb: Likewise.
From-SVN: r168082
2010-12-20 08:26:57 +01:00
|
|
|
-- possibility of overflow.
|
2010-10-25 15:50:29 +02:00
|
|
|
|
|
|
|
if Old_Length > Count_Type'Last - Count then
|
|
|
|
raise Constraint_Error with "Count is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- It is now safe compute the length of the new vector, without fear of
|
|
|
|
-- overflow.
|
|
|
|
|
|
|
|
New_Length := Old_Length + Count;
|
|
|
|
|
|
|
|
-- The second constraint is that the new Last index value cannot exceed
|
|
|
|
-- Index_Type'Last. In each branch below, we calculate the maximum
|
|
|
|
-- length (computed from the range of values in Index_Type), and then
|
|
|
|
-- compare the new length to the maximum length. If the new length is
|
|
|
|
-- acceptable, then we compute the new last index from that.
|
|
|
|
|
|
|
|
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
|
|
|
-- We have to handle the case when there might be more values in the
|
|
|
|
-- range of Index_Type than in the range of Count_Type.
|
|
|
|
|
|
|
|
if Index_Type'First <= 0 then
|
|
|
|
-- We know that No_Index (the same as Index_Type'First - 1) is
|
|
|
|
-- less than 0, so it is safe to compute the following sum without
|
|
|
|
-- fear of overflow.
|
|
|
|
|
|
|
|
Index := No_Index + Index_Type'Base (Count_Type'Last);
|
|
|
|
|
|
|
|
if Index <= Index_Type'Last then
|
|
|
|
-- We have determined that range of Index_Type has at least as
|
|
|
|
-- many values as in Count_Type, so Count_Type'Last is the
|
|
|
|
-- maximum number of items that are allowed.
|
|
|
|
|
|
|
|
Max_Length := Count_Type'Last;
|
|
|
|
|
|
|
|
else
|
|
|
|
-- The range of Index_Type has fewer values than in Count_Type,
|
|
|
|
-- so the maximum number of items is computed from the range of
|
|
|
|
-- the Index_Type.
|
|
|
|
|
|
|
|
Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
else
|
|
|
|
-- No_Index is equal or greater than 0, so we can safely compute
|
|
|
|
-- the difference without fear of overflow (which we would have to
|
|
|
|
-- worry about if No_Index were less than 0, but that case is
|
|
|
|
-- handled above).
|
|
|
|
|
|
|
|
Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
elsif Index_Type'First <= 0 then
|
|
|
|
-- We know that No_Index (the same as Index_Type'First - 1) is less
|
|
|
|
-- than 0, so it is safe to compute the following sum without fear of
|
|
|
|
-- overflow.
|
|
|
|
|
|
|
|
J := Count_Type'Base (No_Index) + Count_Type'Last;
|
|
|
|
|
|
|
|
if J <= Count_Type'Base (Index_Type'Last) then
|
|
|
|
-- We have determined that range of Index_Type has at least as
|
|
|
|
-- many values as in Count_Type, so Count_Type'Last is the maximum
|
|
|
|
-- number of items that are allowed.
|
|
|
|
|
|
|
|
Max_Length := Count_Type'Last;
|
|
|
|
|
|
|
|
else
|
|
|
|
-- The range of Index_Type has fewer values than Count_Type does,
|
|
|
|
-- so the maximum number of items is computed from the range of
|
|
|
|
-- the Index_Type.
|
|
|
|
|
|
|
|
Max_Length :=
|
|
|
|
Count_Type'Base (Index_Type'Last) - Count_Type'Base (No_Index);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
else
|
|
|
|
-- No_Index is equal or greater than 0, so we can safely compute the
|
|
|
|
-- difference without fear of overflow (which we would have to worry
|
|
|
|
-- about if No_Index were less than 0, but that case is handled
|
|
|
|
-- above).
|
|
|
|
|
|
|
|
Max_Length :=
|
|
|
|
Count_Type'Base (Index_Type'Last) - Count_Type'Base (No_Index);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We have just computed the maximum length (number of items). We must
|
|
|
|
-- now compare the requested length to the maximum length, as we do not
|
|
|
|
-- allow a vector expand beyond the maximum (because that would create
|
|
|
|
-- an internal array with a last index value greater than
|
|
|
|
-- Index_Type'Last, with no way to index those elements).
|
|
|
|
|
|
|
|
if New_Length > Max_Length then
|
|
|
|
raise Constraint_Error with "Count is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- The tampering bits exist to prevent an item from being harmfully
|
|
|
|
-- manipulated while it is being visited. Query, Update, and Iterate
|
|
|
|
-- increment the busy count on entry, and decrement the count on
|
|
|
|
-- exit. Insert checks the count to determine whether it is being called
|
|
|
|
-- while the associated callback procedure is executing.
|
|
|
|
|
|
|
|
if Container.Busy > 0 then
|
|
|
|
raise Program_Error with
|
|
|
|
"attempt to tamper with cursors (vector is busy)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if New_Length > Container.Capacity then
|
|
|
|
raise Capacity_Error with "New length is larger than capacity";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
J := To_Array_Index (Before);
|
|
|
|
|
|
|
|
if Before > Container.Last then
|
|
|
|
-- The new items are being appended to the vector, so no
|
|
|
|
-- sliding of existing elements is required.
|
|
|
|
|
|
|
|
EA (J .. New_Length) := (others => New_Item);
|
|
|
|
|
|
|
|
else
|
|
|
|
-- The new items are being inserted before some existing
|
|
|
|
-- elements, so we must slide the existing elements up to their
|
|
|
|
-- new home.
|
|
|
|
|
|
|
|
EA (J + Count .. New_Length) := EA (J .. Old_Length);
|
|
|
|
EA (J .. J + Count - 1) := (others => New_Item);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
|
|
|
Container.Last := No_Index + Index_Type'Base (New_Length);
|
|
|
|
|
|
|
|
else
|
|
|
|
Container.Last :=
|
|
|
|
Index_Type'Base (Count_Type'Base (No_Index) + New_Length);
|
|
|
|
end if;
|
|
|
|
end Insert;
|
|
|
|
|
|
|
|
procedure Insert
|
|
|
|
(Container : in out Vector;
|
|
|
|
Before : Extended_Index;
|
|
|
|
New_Item : Vector)
|
|
|
|
is
|
|
|
|
N : constant Count_Type := Length (New_Item);
|
|
|
|
B : Count_Type; -- index Before converted to Count_Type
|
|
|
|
|
|
|
|
begin
|
|
|
|
-- Use Insert_Space to create the "hole" (the destination slice) into
|
|
|
|
-- which we copy the source items.
|
|
|
|
|
|
|
|
Insert_Space (Container, Before, Count => N);
|
|
|
|
|
|
|
|
if N = 0 then
|
|
|
|
-- There's nothing else to do here (vetting of parameters was
|
|
|
|
-- performed already in Insert_Space), so we simply return.
|
|
|
|
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
B := To_Array_Index (Before);
|
|
|
|
|
|
|
|
if Container'Address /= New_Item'Address then
|
|
|
|
-- This is the simple case. New_Item denotes an object different
|
|
|
|
-- from Container, so there's nothing special we need to do to copy
|
|
|
|
-- the source items to their destination, because all of the source
|
|
|
|
-- items are contiguous.
|
|
|
|
|
|
|
|
Container.Elements (B .. B + N - 1) := New_Item.Elements (1 .. N);
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We refer to array index value Before + N - 1 as J. This is the last
|
|
|
|
-- index value of the destination slice.
|
|
|
|
|
|
|
|
-- New_Item denotes the same object as Container, so an insertion has
|
|
|
|
-- potentially split the source items. The destination is always the
|
|
|
|
-- range [Before, J], but the source is [Index_Type'First, Before) and
|
|
|
|
-- (J, Container.Last]. We perform the copy in two steps, using each of
|
|
|
|
-- the two slices of the source items.
|
|
|
|
|
|
|
|
declare
|
|
|
|
subtype Src_Index_Subtype is Count_Type'Base range 1 .. B - 1;
|
|
|
|
|
|
|
|
Src : Elements_Array renames Container.Elements (Src_Index_Subtype);
|
|
|
|
|
|
|
|
begin
|
|
|
|
-- We first copy the source items that precede the space we
|
|
|
|
-- inserted. (If Before equals Index_Type'First, then this first
|
|
|
|
-- source slice will be empty, which is harmless.)
|
|
|
|
|
|
|
|
Container.Elements (B .. B + Src'Length - 1) := Src;
|
|
|
|
end;
|
|
|
|
|
|
|
|
declare
|
|
|
|
subtype Src_Index_Subtype is Count_Type'Base range
|
|
|
|
B + N .. Container.Length;
|
|
|
|
|
|
|
|
Src : Elements_Array renames Container.Elements (Src_Index_Subtype);
|
|
|
|
|
|
|
|
begin
|
|
|
|
-- We next copy the source items that follow the space we inserted.
|
|
|
|
|
|
|
|
Container.Elements (B + N - Src'Length .. B + N - 1) := Src;
|
|
|
|
end;
|
|
|
|
end Insert;
|
|
|
|
|
|
|
|
procedure Insert
|
|
|
|
(Container : in out Vector;
|
|
|
|
Before : Cursor;
|
|
|
|
New_Item : Vector)
|
|
|
|
is
|
|
|
|
Index : Index_Type'Base;
|
|
|
|
|
|
|
|
begin
|
|
|
|
if Before.Container /= null
|
|
|
|
and then Before.Container /= Container'Unchecked_Access
|
|
|
|
then
|
|
|
|
raise Program_Error with "Before cursor denotes wrong container";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Is_Empty (New_Item) then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Before.Container = null
|
|
|
|
or else Before.Index > Container.Last
|
|
|
|
then
|
|
|
|
if Container.Last = Index_Type'Last then
|
|
|
|
raise Constraint_Error with
|
|
|
|
"vector is already at its maximum length";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Index := Container.Last + 1;
|
|
|
|
|
|
|
|
else
|
|
|
|
Index := Before.Index;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Insert (Container, Index, New_Item);
|
|
|
|
end Insert;
|
|
|
|
|
|
|
|
procedure Insert
|
|
|
|
(Container : in out Vector;
|
|
|
|
Before : Cursor;
|
|
|
|
New_Item : Vector;
|
|
|
|
Position : out Cursor)
|
|
|
|
is
|
|
|
|
Index : Index_Type'Base;
|
|
|
|
|
|
|
|
begin
|
|
|
|
if Before.Container /= null
|
|
|
|
and then Before.Container /= Container'Unchecked_Access
|
|
|
|
then
|
|
|
|
raise Program_Error with "Before cursor denotes wrong container";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Is_Empty (New_Item) then
|
|
|
|
if Before.Container = null
|
|
|
|
or else Before.Index > Container.Last
|
|
|
|
then
|
|
|
|
Position := No_Element;
|
|
|
|
else
|
|
|
|
Position := (Container'Unchecked_Access, Before.Index);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Before.Container = null
|
|
|
|
or else Before.Index > Container.Last
|
|
|
|
then
|
|
|
|
if Container.Last = Index_Type'Last then
|
|
|
|
raise Constraint_Error with
|
|
|
|
"vector is already at its maximum length";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Index := Container.Last + 1;
|
|
|
|
|
|
|
|
else
|
|
|
|
Index := Before.Index;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Insert (Container, Index, New_Item);
|
|
|
|
|
|
|
|
Position := Cursor'(Container'Unchecked_Access, Index);
|
|
|
|
end Insert;
|
|
|
|
|
|
|
|
procedure Insert
|
|
|
|
(Container : in out Vector;
|
|
|
|
Before : Cursor;
|
|
|
|
New_Item : Element_Type;
|
|
|
|
Count : Count_Type := 1)
|
|
|
|
is
|
|
|
|
Index : Index_Type'Base;
|
|
|
|
|
|
|
|
begin
|
|
|
|
if Before.Container /= null
|
|
|
|
and then Before.Container /= Container'Unchecked_Access
|
|
|
|
then
|
|
|
|
raise Program_Error with "Before cursor denotes wrong container";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Count = 0 then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Before.Container = null
|
|
|
|
or else Before.Index > Container.Last
|
|
|
|
then
|
|
|
|
if Container.Last = Index_Type'Last then
|
|
|
|
raise Constraint_Error with
|
|
|
|
"vector is already at its maximum length";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Index := Container.Last + 1;
|
|
|
|
|
|
|
|
else
|
|
|
|
Index := Before.Index;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Insert (Container, Index, New_Item, Count);
|
|
|
|
end Insert;
|
|
|
|
|
|
|
|
procedure Insert
|
|
|
|
(Container : in out Vector;
|
|
|
|
Before : Cursor;
|
|
|
|
New_Item : Element_Type;
|
|
|
|
Position : out Cursor;
|
|
|
|
Count : Count_Type := 1)
|
|
|
|
is
|
|
|
|
Index : Index_Type'Base;
|
|
|
|
|
|
|
|
begin
|
|
|
|
if Before.Container /= null
|
|
|
|
and then Before.Container /= Container'Unchecked_Access
|
|
|
|
then
|
|
|
|
raise Program_Error with "Before cursor denotes wrong container";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Count = 0 then
|
|
|
|
if Before.Container = null
|
|
|
|
or else Before.Index > Container.Last
|
|
|
|
then
|
|
|
|
Position := No_Element;
|
|
|
|
else
|
|
|
|
Position := (Container'Unchecked_Access, Before.Index);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Before.Container = null
|
|
|
|
or else Before.Index > Container.Last
|
|
|
|
then
|
|
|
|
if Container.Last = Index_Type'Last then
|
|
|
|
raise Constraint_Error with
|
|
|
|
"vector is already at its maximum length";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Index := Container.Last + 1;
|
|
|
|
|
|
|
|
else
|
|
|
|
Index := Before.Index;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Insert (Container, Index, New_Item, Count);
|
|
|
|
|
|
|
|
Position := Cursor'(Container'Unchecked_Access, Index);
|
|
|
|
end Insert;
|
|
|
|
|
|
|
|
procedure Insert
|
|
|
|
(Container : in out Vector;
|
|
|
|
Before : Extended_Index;
|
|
|
|
Count : Count_Type := 1)
|
|
|
|
is
|
|
|
|
New_Item : Element_Type; -- Default-initialized value
|
|
|
|
pragma Warnings (Off, New_Item);
|
|
|
|
|
|
|
|
begin
|
|
|
|
Insert (Container, Before, New_Item, Count);
|
|
|
|
end Insert;
|
|
|
|
|
|
|
|
procedure Insert
|
|
|
|
(Container : in out Vector;
|
|
|
|
Before : Cursor;
|
|
|
|
Position : out Cursor;
|
|
|
|
Count : Count_Type := 1)
|
|
|
|
is
|
|
|
|
New_Item : Element_Type; -- Default-initialized value
|
|
|
|
pragma Warnings (Off, New_Item);
|
|
|
|
|
|
|
|
begin
|
|
|
|
Insert (Container, Before, New_Item, Position, Count);
|
|
|
|
end Insert;
|
|
|
|
|
|
|
|
------------------
|
|
|
|
-- Insert_Space --
|
|
|
|
------------------
|
|
|
|
|
|
|
|
procedure Insert_Space
|
|
|
|
(Container : in out Vector;
|
|
|
|
Before : Extended_Index;
|
|
|
|
Count : Count_Type := 1)
|
|
|
|
is
|
|
|
|
EA : Elements_Array renames Container.Elements;
|
|
|
|
Old_Length : constant Count_Type := Container.Length;
|
|
|
|
|
|
|
|
Max_Length : Count_Type'Base; -- determined from range of Index_Type
|
|
|
|
New_Length : Count_Type'Base; -- sum of current length and Count
|
|
|
|
|
|
|
|
Index : Index_Type'Base; -- scratch for intermediate values
|
|
|
|
J : Count_Type'Base; -- scratch
|
|
|
|
|
|
|
|
begin
|
|
|
|
-- As a precondition on the generic actual Index_Type, the base type
|
|
|
|
-- must include Index_Type'Pred (Index_Type'First); this is the value
|
|
|
|
-- that Container.Last assumes when the vector is empty. However, we do
|
|
|
|
-- not allow that as the value for Index when specifying where the new
|
|
|
|
-- items should be inserted, so we must manually check. (That the user
|
|
|
|
-- is allowed to specify the value at all here is a consequence of the
|
|
|
|
-- declaration of the Extended_Index subtype, which includes the values
|
|
|
|
-- in the base range that immediately precede and immediately follow the
|
|
|
|
-- values in the Index_Type.)
|
|
|
|
|
|
|
|
if Before < Index_Type'First then
|
|
|
|
raise Constraint_Error with
|
|
|
|
"Before index is out of range (too small)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We do allow a value greater than Container.Last to be specified as
|
|
|
|
-- the Index, but only if it's immediately greater. This allows for the
|
|
|
|
-- case of appending items to the back end of the vector. (It is assumed
|
|
|
|
-- that specifying an index value greater than Last + 1 indicates some
|
|
|
|
-- deeper flaw in the caller's algorithm, so that case is treated as a
|
|
|
|
-- proper error.)
|
|
|
|
|
|
|
|
if Before > Container.Last
|
|
|
|
and then Before > Container.Last + 1
|
|
|
|
then
|
|
|
|
raise Constraint_Error with
|
|
|
|
"Before index is out of range (too large)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We treat inserting 0 items into the container as a no-op, even when
|
|
|
|
-- the container is busy, so we simply return.
|
|
|
|
|
|
|
|
if Count = 0 then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- There are two constraints we need to satisfy. The first constraint is
|
|
|
|
-- that a container cannot have more than Count_Type'Last elements, so
|
[multiple changes]
2011-09-15 Robert Dewar <dewar@adacore.com>
* a-cdlili.adb, a-coinve.adb, a-stzunb-shared.ads, a-suezst.adb,
a-suenco.adb, a-stwiun-shared.ads, a-cobove.adb, a-convec.adb,
a-btgbso.adb, a-cbdlli.adb, a-suewst.adb: Minor reformatting.
2011-09-15 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Expression_Function): Code cleanup:
if the expression function is not a completion, create a
new specification for the generated declaration, and keep the
original specification in the generated body. Shorter code also
ensures that proper warnings are generated for unused formals
in all cases.
2011-09-15 Sergey Rybin <rybin@adacore.com>
* tree_io.ads: Update ASIS_Version_Number because of the changes
in the tree structures for expression functions.
2011-09-15 Arnaud Charlet <charlet@adacore.com>
* s-osinte-aix.ads, s-osinte-darwin.ads, s-osinte-freebsd.ads,
s-osinte-hpux.ads, s-osinte-lynxos.ads, s-osinte-solaris-posix.ads,
s-taprop-posix.adb (CLOCK_MONOTONIC): New constant.
(CLOCK_REALTIME): Fix wrong value on some OSes.
* s-taprop-posix.adb (Monotonic_Clock): Use CLOCK_MONOTONIC.
From-SVN: r178877
2011-09-15 12:22:54 +02:00
|
|
|
-- we must check the sum of the current length and the insertion count.
|
|
|
|
-- Note that we cannot simply add these values, because of the
|
Fix typos in gcc/ada.
gcc/ada/:
* projects.texi: Fix typos.
* gnat_rm.texi: Likewise.
* gnat_ugn.texi: Likewise.
* sem_util.adb: Fix typo in variable, typos in comments.
* a-btgbso.adb: Fix typos in comments.
* a-cbdlli.adb, a-cbhase.ads, a-cdlili.adb, a-cobove.adb,
a-coinve.adb, a-convec.adb, a-direct.ads, a-strunb-shared.adb,
a-strunb-shared.ads, a-stuten.ads, a-stwiun-shared.adb,
a-stwiun-shared.ads, a-stzunb-shared.adb, a-stzunb-shared.ads,
a-suenco.adb, a-suenst.adb, a-suewst.adb, a-suezst.adb, ali.ads,
aspects.ads, atree.ads, binde.adb, bindgen.adb, checks.adb,
checks.ads, einfo.ads, err_vars.ads, errout.adb, errout.ads,
exp_aggr.adb, exp_attr.adb, exp_cg.adb, exp_ch3.adb,
exp_ch4.adb, exp_ch5.adb, exp_ch6.adb, exp_ch7.adb,
exp_dbug.ads, exp_disp.adb, exp_fixd.ads, freeze.adb,
g-altive.ads, g-comlin.ads, g-excact.ads, g-mbdira.adb,
g-sechas.ads, g-sehash.ads, g-sha1.ads, g-sha224.ads,
g-sha256.ads, g-sha384.ads, g-sha512.ads, g-shsh32.ads,
g-shsh64.ads, g-socket.adb, g-socket.ads, g-sothco.ads,
gcc-interface/decl.c, gcc-interface/trans.c,
gcc-interface/utils2.c, gnat1drv.adb, init.c, inline.adb,
link.c, locales.c, make.adb, mingw32.h, namet.ads, osint.adb,
par-ch12.adb, par-ch13.adb, par-ch3.adb, par-ch4.adb,
par-prag.adb, par.adb, par_sco.adb, prepcomp.adb,
prj-conf.ads, prj-dect.adb, prj-env.adb, prj-env.ads,
prj-nmsc.adb, prj-tree.ads, prj-util.ads, prj.adb, prj.ads,
s-auxdec-vms-alpha.adb, s-auxdec-vms_64.ads, s-oscons-tmplt.c,
s-osinte-vxworks.ads, s-osprim-mingw.adb, s-regexp.adb,
s-stusta.adb, s-taprop-mingw.adb, s-taprop-solaris.adb,
scn.adb, scos.ads, sem.adb, sem_aggr.adb, sem_attr.adb,
sem_aux.adb, sem_aux.ads, sem_ch12.adb, sem_ch12.ads,
sem_ch13.adb, sem_ch13.ads, sem_ch3.adb, sem_ch4.adb,
sem_ch6.adb, sem_ch7.adb, sem_ch8.adb, sem_disp.adb,
sem_disp.ads, sem_eval.adb, sem_intr.adb, sem_prag.adb,
sem_res.adb, sem_scil.adb, sem_util.ads, sem_warn.adb,
sem_warn.ads, sinfo.ads, socket.c, styleg.adb, switch.ads,
sysdep.c, tb-alvxw.c, xoscons.adb: Likewise.
From-SVN: r168082
2010-12-20 08:26:57 +01:00
|
|
|
-- possibility of overflow.
|
2010-10-25 15:50:29 +02:00
|
|
|
|
|
|
|
if Old_Length > Count_Type'Last - Count then
|
|
|
|
raise Constraint_Error with "Count is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- It is now safe compute the length of the new vector, without fear of
|
|
|
|
-- overflow.
|
|
|
|
|
|
|
|
New_Length := Old_Length + Count;
|
|
|
|
|
|
|
|
-- The second constraint is that the new Last index value cannot exceed
|
|
|
|
-- Index_Type'Last. In each branch below, we calculate the maximum
|
|
|
|
-- length (computed from the range of values in Index_Type), and then
|
|
|
|
-- compare the new length to the maximum length. If the new length is
|
|
|
|
-- acceptable, then we compute the new last index from that.
|
|
|
|
|
|
|
|
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
|
|
|
-- We have to handle the case when there might be more values in the
|
|
|
|
-- range of Index_Type than in the range of Count_Type.
|
|
|
|
|
|
|
|
if Index_Type'First <= 0 then
|
|
|
|
-- We know that No_Index (the same as Index_Type'First - 1) is
|
|
|
|
-- less than 0, so it is safe to compute the following sum without
|
|
|
|
-- fear of overflow.
|
|
|
|
|
|
|
|
Index := No_Index + Index_Type'Base (Count_Type'Last);
|
|
|
|
|
|
|
|
if Index <= Index_Type'Last then
|
|
|
|
-- We have determined that range of Index_Type has at least as
|
|
|
|
-- many values as in Count_Type, so Count_Type'Last is the
|
|
|
|
-- maximum number of items that are allowed.
|
|
|
|
|
|
|
|
Max_Length := Count_Type'Last;
|
|
|
|
|
|
|
|
else
|
|
|
|
-- The range of Index_Type has fewer values than in Count_Type,
|
|
|
|
-- so the maximum number of items is computed from the range of
|
|
|
|
-- the Index_Type.
|
|
|
|
|
|
|
|
Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
else
|
|
|
|
-- No_Index is equal or greater than 0, so we can safely compute
|
|
|
|
-- the difference without fear of overflow (which we would have to
|
|
|
|
-- worry about if No_Index were less than 0, but that case is
|
|
|
|
-- handled above).
|
|
|
|
|
|
|
|
Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
elsif Index_Type'First <= 0 then
|
|
|
|
-- We know that No_Index (the same as Index_Type'First - 1) is less
|
|
|
|
-- than 0, so it is safe to compute the following sum without fear of
|
|
|
|
-- overflow.
|
|
|
|
|
|
|
|
J := Count_Type'Base (No_Index) + Count_Type'Last;
|
|
|
|
|
|
|
|
if J <= Count_Type'Base (Index_Type'Last) then
|
|
|
|
-- We have determined that range of Index_Type has at least as
|
|
|
|
-- many values as in Count_Type, so Count_Type'Last is the maximum
|
|
|
|
-- number of items that are allowed.
|
|
|
|
|
|
|
|
Max_Length := Count_Type'Last;
|
|
|
|
|
|
|
|
else
|
|
|
|
-- The range of Index_Type has fewer values than Count_Type does,
|
|
|
|
-- so the maximum number of items is computed from the range of
|
|
|
|
-- the Index_Type.
|
|
|
|
|
|
|
|
Max_Length :=
|
|
|
|
Count_Type'Base (Index_Type'Last) - Count_Type'Base (No_Index);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
else
|
|
|
|
-- No_Index is equal or greater than 0, so we can safely compute the
|
|
|
|
-- difference without fear of overflow (which we would have to worry
|
|
|
|
-- about if No_Index were less than 0, but that case is handled
|
|
|
|
-- above).
|
|
|
|
|
|
|
|
Max_Length :=
|
|
|
|
Count_Type'Base (Index_Type'Last) - Count_Type'Base (No_Index);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We have just computed the maximum length (number of items). We must
|
|
|
|
-- now compare the requested length to the maximum length, as we do not
|
|
|
|
-- allow a vector expand beyond the maximum (because that would create
|
|
|
|
-- an internal array with a last index value greater than
|
|
|
|
-- Index_Type'Last, with no way to index those elements).
|
|
|
|
|
|
|
|
if New_Length > Max_Length then
|
|
|
|
raise Constraint_Error with "Count is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- The tampering bits exist to prevent an item from being harmfully
|
|
|
|
-- manipulated while it is being visited. Query, Update, and Iterate
|
|
|
|
-- increment the busy count on entry, and decrement the count on
|
|
|
|
-- exit. Insert checks the count to determine whether it is being called
|
|
|
|
-- while the associated callback procedure is executing.
|
|
|
|
|
|
|
|
if Container.Busy > 0 then
|
|
|
|
raise Program_Error with
|
|
|
|
"attempt to tamper with cursors (vector is busy)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- An internal array has already been allocated, so we need to check
|
|
|
|
-- whether there is enough unused storage for the new items.
|
|
|
|
|
|
|
|
if New_Length > Container.Capacity then
|
|
|
|
raise Capacity_Error with "New length is larger than capacity";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- In this case, we're inserting space into a vector that has already
|
|
|
|
-- allocated an internal array, and the existing array has enough
|
|
|
|
-- unused storage for the new items.
|
|
|
|
|
|
|
|
if Before <= Container.Last then
|
|
|
|
-- The space is being inserted before some existing elements,
|
|
|
|
-- so we must slide the existing elements up to their new home.
|
|
|
|
|
|
|
|
J := To_Array_Index (Before);
|
|
|
|
EA (J + Count .. New_Length) := EA (J .. Old_Length);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- New_Last is the last index value of the items in the container after
|
|
|
|
-- insertion. Use the wider of Index_Type'Base and Count_Type'Base to
|
|
|
|
-- compute its value from the New_Length.
|
|
|
|
|
|
|
|
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
|
|
|
Container.Last := No_Index + Index_Type'Base (New_Length);
|
|
|
|
|
|
|
|
else
|
|
|
|
Container.Last :=
|
|
|
|
Index_Type'Base (Count_Type'Base (No_Index) + New_Length);
|
|
|
|
end if;
|
|
|
|
end Insert_Space;
|
|
|
|
|
|
|
|
procedure Insert_Space
|
|
|
|
(Container : in out Vector;
|
|
|
|
Before : Cursor;
|
|
|
|
Position : out Cursor;
|
|
|
|
Count : Count_Type := 1)
|
|
|
|
is
|
|
|
|
Index : Index_Type'Base;
|
|
|
|
|
|
|
|
begin
|
|
|
|
if Before.Container /= null
|
|
|
|
and then Before.Container /= Container'Unchecked_Access
|
|
|
|
then
|
|
|
|
raise Program_Error with "Before cursor denotes wrong container";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Count = 0 then
|
|
|
|
if Before.Container = null
|
|
|
|
or else Before.Index > Container.Last
|
|
|
|
then
|
|
|
|
Position := No_Element;
|
|
|
|
else
|
|
|
|
Position := (Container'Unchecked_Access, Before.Index);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Before.Container = null
|
|
|
|
or else Before.Index > Container.Last
|
|
|
|
then
|
|
|
|
if Container.Last = Index_Type'Last then
|
|
|
|
raise Constraint_Error with
|
|
|
|
"vector is already at its maximum length";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Index := Container.Last + 1;
|
|
|
|
|
|
|
|
else
|
|
|
|
Index := Before.Index;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Insert_Space (Container, Index, Count => Count);
|
|
|
|
|
|
|
|
Position := Cursor'(Container'Unchecked_Access, Index);
|
|
|
|
end Insert_Space;
|
|
|
|
|
|
|
|
--------------
|
|
|
|
-- Is_Empty --
|
|
|
|
--------------
|
|
|
|
|
|
|
|
function Is_Empty (Container : Vector) return Boolean is
|
|
|
|
begin
|
|
|
|
return Container.Last < Index_Type'First;
|
|
|
|
end Is_Empty;
|
|
|
|
|
|
|
|
-------------
|
|
|
|
-- Iterate --
|
|
|
|
-------------
|
|
|
|
|
|
|
|
procedure Iterate
|
|
|
|
(Container : Vector;
|
|
|
|
Process : not null access procedure (Position : Cursor))
|
|
|
|
is
|
[multiple changes]
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Freeze_All_Ent): An incomplete type is not
frozen by a subprogram body that does not come from source.
2011-11-23 Pascal Obry <obry@adacore.com>
* s-oscons-tmplt.c: Add PTY_Library constant. It contains
the library for pseudo terminal support.
* g-exptty.ads: Add pseudo-terminal library into a Linker_Options
pragma.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch9.adb: No check on entry family index if generic.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* sem_ch9.adb, s-taprop.ads, s-taprop-hpux-dce.adb, s-taprop-irix.adb,
s-taprop-posix.adb, s-taprop-rtx.adb, s-taprop-solaris.adb,
s-taprop-tru64.adb, s-taprop-vxworks.adb: Move dependency on
System.OS_Constants from shared spec of
System.Tasking.Primitive_Operations to the specific body variants
that really require this dependency.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming_Declaration):
If the declaration has aspects, analyze them so they can be
properly rejected.
2011-11-23 Hristian Kirtchev <kirtchev@adacore.com>
* a-comutr.adb, a-coorma.adb, a-coorse.adb, a-convec.adb, a-cihase.adb,
a-cimutr.adb, a-coinve.adb, a-ciorma.adb, a-ciorse.adb, a-cobove.adb,
a-cohama.adb, a-cihama.adb, a-cidlli.adb, a-cdlili.adb, a-cbhama.adb,
a-cbhase.adb, a-cbmutr.adb, a-cborma.adb, a-cborse.adb, a-cbdlli.adb:
Add with and use clause for Ada.Finalization. Type
Iterator and Child_Iterator are now derived from Limited_Controlled.
(Finalize): New routine.
(Iterate): Add a renaming of counter Busy and
increment it. Update the return aggregate.
(Iterate_Children): Add a renaming of
counter Busy and increment it. Update the return aggregate.
(Iterate_Subtree): Add a renaming of counter Busy and increment
it. Update the return aggregate.
* a-cdlili.ads, a-cidlli.ads: Type List_Access is now a general access
type.
* a-cihama.ads: Type Map_Access is now a general access type.
* a-comutr.ads, a-cimutr.ads: Use type Natural for the two locks
associated with the tree.
* a-cohama.ads: Type Map_Access is now a general access type.
* a-coinve.ads, a-convec.ads: Type Vector_Access is now a general
access type.
* exp_ch5.adb (Expand_Iterator_Loop): Do not create a block
to wrap the loop as this is done at an earlier step, during
analysis. The declarations of the iterator and the cursor use
the usual Insert_Action mechanism when added into the tree.
* sem_ch5.adb (Analyze_Loop_Statement): Remove local constant
Loop_Statement and replace all respective uses by N. Add local
constant Loc. Preanalyze the loop iterator to discover whether
it is a container iterator and if it is, wrap the loop in a
block. This ensures that any controlled temporaries produced
by the iteration scheme share the same lifetime of the loop.
(Is_Container_Iterator): New routine.
(Is_Wrapped_In_Block): New routine.
(Pre_Analyze_Range): Move spec and body to the library level.
2011-11-23 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi, vms_data.ads: Add documentation for new gnatpp option
that controls casing of type and subtype names.
2011-11-23 Yannick Moy <moy@adacore.com>
* sem_ch3.adb: Minor addition of comments.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* prj-part.adb (Extension_Withs): New global variable,
contains the head of the list of WITH clauses from the EXTENDS
ALL projects for which virtual packages are being created.
(Look_For_Virtual_Projects_For): When recursing through
an EXTENDS ALL, add the WITH clauses of the extending
project to Extension_Withs. When adding a project to the
Virtual_Hash, record the associated Extension_Withs list.
(Create_Virtual_Extending_Project): Add a copy of the appropriate
Extension_Withs to the virtual project.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* mlib-tgt-specific-vxworks.adb: Minor reformatting.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* Make-generated.in (Sdefault.Target_Name): Set to
$(target_noncanonical) instead of $(target) for consistency.
From-SVN: r181668
2011-11-23 14:51:23 +01:00
|
|
|
B : Natural renames Container'Unrestricted_Access.all.Busy;
|
2010-10-25 15:50:29 +02:00
|
|
|
|
|
|
|
begin
|
|
|
|
B := B + 1;
|
|
|
|
|
|
|
|
begin
|
|
|
|
for Indx in Index_Type'First .. Container.Last loop
|
|
|
|
Process (Cursor'(Container'Unrestricted_Access, Indx));
|
|
|
|
end loop;
|
|
|
|
exception
|
|
|
|
when others =>
|
|
|
|
B := B - 1;
|
|
|
|
raise;
|
|
|
|
end;
|
|
|
|
|
|
|
|
B := B - 1;
|
|
|
|
end Iterate;
|
|
|
|
|
[multiple changes]
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
package spec.
* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
while raising PE.
From-SVN: r178245
2011-08-29 16:25:19 +02:00
|
|
|
function Iterate
|
|
|
|
(Container : Vector)
|
2011-08-29 16:19:32 +02:00
|
|
|
return Vector_Iterator_Interfaces.Reversible_Iterator'Class
|
|
|
|
is
|
2011-12-12 12:28:03 +01:00
|
|
|
V : constant Vector_Access := Container'Unrestricted_Access;
|
|
|
|
B : Natural renames V.Busy;
|
|
|
|
|
2011-08-29 16:19:32 +02:00
|
|
|
begin
|
2011-12-12 12:28:03 +01:00
|
|
|
-- The value of its Index component influences the behavior of the First
|
|
|
|
-- and Last selector functions of the iterator object. When the Index
|
|
|
|
-- component is No_Index (as is the case here), this means the iterator
|
|
|
|
-- object was constructed without a start expression. This is a complete
|
|
|
|
-- iterator, meaning that the iteration starts from the (logical)
|
|
|
|
-- beginning of the sequence of items.
|
|
|
|
|
|
|
|
-- Note: For a forward iterator, Container.First is the beginning, and
|
|
|
|
-- for a reverse iterator, Container.Last is the beginning.
|
|
|
|
|
[multiple changes]
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Freeze_All_Ent): An incomplete type is not
frozen by a subprogram body that does not come from source.
2011-11-23 Pascal Obry <obry@adacore.com>
* s-oscons-tmplt.c: Add PTY_Library constant. It contains
the library for pseudo terminal support.
* g-exptty.ads: Add pseudo-terminal library into a Linker_Options
pragma.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch9.adb: No check on entry family index if generic.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* sem_ch9.adb, s-taprop.ads, s-taprop-hpux-dce.adb, s-taprop-irix.adb,
s-taprop-posix.adb, s-taprop-rtx.adb, s-taprop-solaris.adb,
s-taprop-tru64.adb, s-taprop-vxworks.adb: Move dependency on
System.OS_Constants from shared spec of
System.Tasking.Primitive_Operations to the specific body variants
that really require this dependency.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming_Declaration):
If the declaration has aspects, analyze them so they can be
properly rejected.
2011-11-23 Hristian Kirtchev <kirtchev@adacore.com>
* a-comutr.adb, a-coorma.adb, a-coorse.adb, a-convec.adb, a-cihase.adb,
a-cimutr.adb, a-coinve.adb, a-ciorma.adb, a-ciorse.adb, a-cobove.adb,
a-cohama.adb, a-cihama.adb, a-cidlli.adb, a-cdlili.adb, a-cbhama.adb,
a-cbhase.adb, a-cbmutr.adb, a-cborma.adb, a-cborse.adb, a-cbdlli.adb:
Add with and use clause for Ada.Finalization. Type
Iterator and Child_Iterator are now derived from Limited_Controlled.
(Finalize): New routine.
(Iterate): Add a renaming of counter Busy and
increment it. Update the return aggregate.
(Iterate_Children): Add a renaming of
counter Busy and increment it. Update the return aggregate.
(Iterate_Subtree): Add a renaming of counter Busy and increment
it. Update the return aggregate.
* a-cdlili.ads, a-cidlli.ads: Type List_Access is now a general access
type.
* a-cihama.ads: Type Map_Access is now a general access type.
* a-comutr.ads, a-cimutr.ads: Use type Natural for the two locks
associated with the tree.
* a-cohama.ads: Type Map_Access is now a general access type.
* a-coinve.ads, a-convec.ads: Type Vector_Access is now a general
access type.
* exp_ch5.adb (Expand_Iterator_Loop): Do not create a block
to wrap the loop as this is done at an earlier step, during
analysis. The declarations of the iterator and the cursor use
the usual Insert_Action mechanism when added into the tree.
* sem_ch5.adb (Analyze_Loop_Statement): Remove local constant
Loop_Statement and replace all respective uses by N. Add local
constant Loc. Preanalyze the loop iterator to discover whether
it is a container iterator and if it is, wrap the loop in a
block. This ensures that any controlled temporaries produced
by the iteration scheme share the same lifetime of the loop.
(Is_Container_Iterator): New routine.
(Is_Wrapped_In_Block): New routine.
(Pre_Analyze_Range): Move spec and body to the library level.
2011-11-23 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi, vms_data.ads: Add documentation for new gnatpp option
that controls casing of type and subtype names.
2011-11-23 Yannick Moy <moy@adacore.com>
* sem_ch3.adb: Minor addition of comments.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* prj-part.adb (Extension_Withs): New global variable,
contains the head of the list of WITH clauses from the EXTENDS
ALL projects for which virtual packages are being created.
(Look_For_Virtual_Projects_For): When recursing through
an EXTENDS ALL, add the WITH clauses of the extending
project to Extension_Withs. When adding a project to the
Virtual_Hash, record the associated Extension_Withs list.
(Create_Virtual_Extending_Project): Add a copy of the appropriate
Extension_Withs to the virtual project.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* mlib-tgt-specific-vxworks.adb: Minor reformatting.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* Make-generated.in (Sdefault.Target_Name): Set to
$(target_noncanonical) instead of $(target) for consistency.
From-SVN: r181668
2011-11-23 14:51:23 +01:00
|
|
|
return It : constant Iterator :=
|
2011-12-12 12:28:03 +01:00
|
|
|
(Limited_Controlled with
|
|
|
|
Container => V,
|
|
|
|
Index => No_Index)
|
[multiple changes]
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Freeze_All_Ent): An incomplete type is not
frozen by a subprogram body that does not come from source.
2011-11-23 Pascal Obry <obry@adacore.com>
* s-oscons-tmplt.c: Add PTY_Library constant. It contains
the library for pseudo terminal support.
* g-exptty.ads: Add pseudo-terminal library into a Linker_Options
pragma.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch9.adb: No check on entry family index if generic.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* sem_ch9.adb, s-taprop.ads, s-taprop-hpux-dce.adb, s-taprop-irix.adb,
s-taprop-posix.adb, s-taprop-rtx.adb, s-taprop-solaris.adb,
s-taprop-tru64.adb, s-taprop-vxworks.adb: Move dependency on
System.OS_Constants from shared spec of
System.Tasking.Primitive_Operations to the specific body variants
that really require this dependency.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming_Declaration):
If the declaration has aspects, analyze them so they can be
properly rejected.
2011-11-23 Hristian Kirtchev <kirtchev@adacore.com>
* a-comutr.adb, a-coorma.adb, a-coorse.adb, a-convec.adb, a-cihase.adb,
a-cimutr.adb, a-coinve.adb, a-ciorma.adb, a-ciorse.adb, a-cobove.adb,
a-cohama.adb, a-cihama.adb, a-cidlli.adb, a-cdlili.adb, a-cbhama.adb,
a-cbhase.adb, a-cbmutr.adb, a-cborma.adb, a-cborse.adb, a-cbdlli.adb:
Add with and use clause for Ada.Finalization. Type
Iterator and Child_Iterator are now derived from Limited_Controlled.
(Finalize): New routine.
(Iterate): Add a renaming of counter Busy and
increment it. Update the return aggregate.
(Iterate_Children): Add a renaming of
counter Busy and increment it. Update the return aggregate.
(Iterate_Subtree): Add a renaming of counter Busy and increment
it. Update the return aggregate.
* a-cdlili.ads, a-cidlli.ads: Type List_Access is now a general access
type.
* a-cihama.ads: Type Map_Access is now a general access type.
* a-comutr.ads, a-cimutr.ads: Use type Natural for the two locks
associated with the tree.
* a-cohama.ads: Type Map_Access is now a general access type.
* a-coinve.ads, a-convec.ads: Type Vector_Access is now a general
access type.
* exp_ch5.adb (Expand_Iterator_Loop): Do not create a block
to wrap the loop as this is done at an earlier step, during
analysis. The declarations of the iterator and the cursor use
the usual Insert_Action mechanism when added into the tree.
* sem_ch5.adb (Analyze_Loop_Statement): Remove local constant
Loop_Statement and replace all respective uses by N. Add local
constant Loc. Preanalyze the loop iterator to discover whether
it is a container iterator and if it is, wrap the loop in a
block. This ensures that any controlled temporaries produced
by the iteration scheme share the same lifetime of the loop.
(Is_Container_Iterator): New routine.
(Is_Wrapped_In_Block): New routine.
(Pre_Analyze_Range): Move spec and body to the library level.
2011-11-23 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi, vms_data.ads: Add documentation for new gnatpp option
that controls casing of type and subtype names.
2011-11-23 Yannick Moy <moy@adacore.com>
* sem_ch3.adb: Minor addition of comments.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* prj-part.adb (Extension_Withs): New global variable,
contains the head of the list of WITH clauses from the EXTENDS
ALL projects for which virtual packages are being created.
(Look_For_Virtual_Projects_For): When recursing through
an EXTENDS ALL, add the WITH clauses of the extending
project to Extension_Withs. When adding a project to the
Virtual_Hash, record the associated Extension_Withs list.
(Create_Virtual_Extending_Project): Add a copy of the appropriate
Extension_Withs to the virtual project.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* mlib-tgt-specific-vxworks.adb: Minor reformatting.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* Make-generated.in (Sdefault.Target_Name): Set to
$(target_noncanonical) instead of $(target) for consistency.
From-SVN: r181668
2011-11-23 14:51:23 +01:00
|
|
|
do
|
|
|
|
B := B + 1;
|
|
|
|
end return;
|
2011-08-29 16:19:32 +02:00
|
|
|
end Iterate;
|
|
|
|
|
[multiple changes]
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
package spec.
* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
while raising PE.
From-SVN: r178245
2011-08-29 16:25:19 +02:00
|
|
|
function Iterate
|
|
|
|
(Container : Vector;
|
|
|
|
Start : Cursor)
|
2011-12-12 12:28:03 +01:00
|
|
|
return Vector_Iterator_Interfaces.Reversible_Iterator'Class
|
2011-08-29 16:19:32 +02:00
|
|
|
is
|
2011-12-12 12:28:03 +01:00
|
|
|
V : constant Vector_Access := Container'Unrestricted_Access;
|
|
|
|
B : Natural renames V.Busy;
|
|
|
|
|
2011-08-29 16:19:32 +02:00
|
|
|
begin
|
2011-12-12 12:28:03 +01:00
|
|
|
-- It was formerly the case that when Start = No_Element, the partial
|
|
|
|
-- iterator was defined to behave the same as for a complete iterator,
|
|
|
|
-- and iterate over the entire sequence of items. However, those
|
|
|
|
-- semantics were unintuitive and arguably error-prone (it is too easy
|
|
|
|
-- to accidentally create an endless loop), and so they were changed,
|
|
|
|
-- per the ARG meeting in Denver on 2011/11. However, there was no
|
|
|
|
-- consensus about what positive meaning this corner case should have,
|
|
|
|
-- and so it was decided to simply raise an exception. This does imply,
|
|
|
|
-- however, that it is not possible to use a partial iterator to specify
|
|
|
|
-- an empty sequence of items.
|
|
|
|
|
|
|
|
if Start.Container = null then
|
|
|
|
raise Constraint_Error with
|
|
|
|
"Start position for iterator equals No_Element";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Start.Container /= V then
|
|
|
|
raise Program_Error with
|
|
|
|
"Start cursor of Iterate designates wrong vector";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Start.Index > V.Last then
|
|
|
|
raise Constraint_Error with
|
|
|
|
"Start position for iterator equals No_Element";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- The value of its Index component influences the behavior of the First
|
|
|
|
-- and Last selector functions of the iterator object. When the Index
|
|
|
|
-- component is not No_Index (as is the case here), it means that this
|
|
|
|
-- is a partial iteration, over a subset of the complete sequence of
|
|
|
|
-- items. The iterator object was constructed with a start expression,
|
|
|
|
-- indicating the position from which the iteration begins. Note that
|
|
|
|
-- the start position has the same value irrespective of whether this is
|
|
|
|
-- a forward or reverse iteration.
|
|
|
|
|
[multiple changes]
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Freeze_All_Ent): An incomplete type is not
frozen by a subprogram body that does not come from source.
2011-11-23 Pascal Obry <obry@adacore.com>
* s-oscons-tmplt.c: Add PTY_Library constant. It contains
the library for pseudo terminal support.
* g-exptty.ads: Add pseudo-terminal library into a Linker_Options
pragma.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch9.adb: No check on entry family index if generic.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* sem_ch9.adb, s-taprop.ads, s-taprop-hpux-dce.adb, s-taprop-irix.adb,
s-taprop-posix.adb, s-taprop-rtx.adb, s-taprop-solaris.adb,
s-taprop-tru64.adb, s-taprop-vxworks.adb: Move dependency on
System.OS_Constants from shared spec of
System.Tasking.Primitive_Operations to the specific body variants
that really require this dependency.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming_Declaration):
If the declaration has aspects, analyze them so they can be
properly rejected.
2011-11-23 Hristian Kirtchev <kirtchev@adacore.com>
* a-comutr.adb, a-coorma.adb, a-coorse.adb, a-convec.adb, a-cihase.adb,
a-cimutr.adb, a-coinve.adb, a-ciorma.adb, a-ciorse.adb, a-cobove.adb,
a-cohama.adb, a-cihama.adb, a-cidlli.adb, a-cdlili.adb, a-cbhama.adb,
a-cbhase.adb, a-cbmutr.adb, a-cborma.adb, a-cborse.adb, a-cbdlli.adb:
Add with and use clause for Ada.Finalization. Type
Iterator and Child_Iterator are now derived from Limited_Controlled.
(Finalize): New routine.
(Iterate): Add a renaming of counter Busy and
increment it. Update the return aggregate.
(Iterate_Children): Add a renaming of
counter Busy and increment it. Update the return aggregate.
(Iterate_Subtree): Add a renaming of counter Busy and increment
it. Update the return aggregate.
* a-cdlili.ads, a-cidlli.ads: Type List_Access is now a general access
type.
* a-cihama.ads: Type Map_Access is now a general access type.
* a-comutr.ads, a-cimutr.ads: Use type Natural for the two locks
associated with the tree.
* a-cohama.ads: Type Map_Access is now a general access type.
* a-coinve.ads, a-convec.ads: Type Vector_Access is now a general
access type.
* exp_ch5.adb (Expand_Iterator_Loop): Do not create a block
to wrap the loop as this is done at an earlier step, during
analysis. The declarations of the iterator and the cursor use
the usual Insert_Action mechanism when added into the tree.
* sem_ch5.adb (Analyze_Loop_Statement): Remove local constant
Loop_Statement and replace all respective uses by N. Add local
constant Loc. Preanalyze the loop iterator to discover whether
it is a container iterator and if it is, wrap the loop in a
block. This ensures that any controlled temporaries produced
by the iteration scheme share the same lifetime of the loop.
(Is_Container_Iterator): New routine.
(Is_Wrapped_In_Block): New routine.
(Pre_Analyze_Range): Move spec and body to the library level.
2011-11-23 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi, vms_data.ads: Add documentation for new gnatpp option
that controls casing of type and subtype names.
2011-11-23 Yannick Moy <moy@adacore.com>
* sem_ch3.adb: Minor addition of comments.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* prj-part.adb (Extension_Withs): New global variable,
contains the head of the list of WITH clauses from the EXTENDS
ALL projects for which virtual packages are being created.
(Look_For_Virtual_Projects_For): When recursing through
an EXTENDS ALL, add the WITH clauses of the extending
project to Extension_Withs. When adding a project to the
Virtual_Hash, record the associated Extension_Withs list.
(Create_Virtual_Extending_Project): Add a copy of the appropriate
Extension_Withs to the virtual project.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* mlib-tgt-specific-vxworks.adb: Minor reformatting.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* Make-generated.in (Sdefault.Target_Name): Set to
$(target_noncanonical) instead of $(target) for consistency.
From-SVN: r181668
2011-11-23 14:51:23 +01:00
|
|
|
return It : constant Iterator :=
|
2011-12-12 12:28:03 +01:00
|
|
|
(Limited_Controlled with
|
|
|
|
Container => V,
|
|
|
|
Index => Start.Index)
|
[multiple changes]
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Freeze_All_Ent): An incomplete type is not
frozen by a subprogram body that does not come from source.
2011-11-23 Pascal Obry <obry@adacore.com>
* s-oscons-tmplt.c: Add PTY_Library constant. It contains
the library for pseudo terminal support.
* g-exptty.ads: Add pseudo-terminal library into a Linker_Options
pragma.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch9.adb: No check on entry family index if generic.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* sem_ch9.adb, s-taprop.ads, s-taprop-hpux-dce.adb, s-taprop-irix.adb,
s-taprop-posix.adb, s-taprop-rtx.adb, s-taprop-solaris.adb,
s-taprop-tru64.adb, s-taprop-vxworks.adb: Move dependency on
System.OS_Constants from shared spec of
System.Tasking.Primitive_Operations to the specific body variants
that really require this dependency.
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming_Declaration):
If the declaration has aspects, analyze them so they can be
properly rejected.
2011-11-23 Hristian Kirtchev <kirtchev@adacore.com>
* a-comutr.adb, a-coorma.adb, a-coorse.adb, a-convec.adb, a-cihase.adb,
a-cimutr.adb, a-coinve.adb, a-ciorma.adb, a-ciorse.adb, a-cobove.adb,
a-cohama.adb, a-cihama.adb, a-cidlli.adb, a-cdlili.adb, a-cbhama.adb,
a-cbhase.adb, a-cbmutr.adb, a-cborma.adb, a-cborse.adb, a-cbdlli.adb:
Add with and use clause for Ada.Finalization. Type
Iterator and Child_Iterator are now derived from Limited_Controlled.
(Finalize): New routine.
(Iterate): Add a renaming of counter Busy and
increment it. Update the return aggregate.
(Iterate_Children): Add a renaming of
counter Busy and increment it. Update the return aggregate.
(Iterate_Subtree): Add a renaming of counter Busy and increment
it. Update the return aggregate.
* a-cdlili.ads, a-cidlli.ads: Type List_Access is now a general access
type.
* a-cihama.ads: Type Map_Access is now a general access type.
* a-comutr.ads, a-cimutr.ads: Use type Natural for the two locks
associated with the tree.
* a-cohama.ads: Type Map_Access is now a general access type.
* a-coinve.ads, a-convec.ads: Type Vector_Access is now a general
access type.
* exp_ch5.adb (Expand_Iterator_Loop): Do not create a block
to wrap the loop as this is done at an earlier step, during
analysis. The declarations of the iterator and the cursor use
the usual Insert_Action mechanism when added into the tree.
* sem_ch5.adb (Analyze_Loop_Statement): Remove local constant
Loop_Statement and replace all respective uses by N. Add local
constant Loc. Preanalyze the loop iterator to discover whether
it is a container iterator and if it is, wrap the loop in a
block. This ensures that any controlled temporaries produced
by the iteration scheme share the same lifetime of the loop.
(Is_Container_Iterator): New routine.
(Is_Wrapped_In_Block): New routine.
(Pre_Analyze_Range): Move spec and body to the library level.
2011-11-23 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi, vms_data.ads: Add documentation for new gnatpp option
that controls casing of type and subtype names.
2011-11-23 Yannick Moy <moy@adacore.com>
* sem_ch3.adb: Minor addition of comments.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* prj-part.adb (Extension_Withs): New global variable,
contains the head of the list of WITH clauses from the EXTENDS
ALL projects for which virtual packages are being created.
(Look_For_Virtual_Projects_For): When recursing through
an EXTENDS ALL, add the WITH clauses of the extending
project to Extension_Withs. When adding a project to the
Virtual_Hash, record the associated Extension_Withs list.
(Create_Virtual_Extending_Project): Add a copy of the appropriate
Extension_Withs to the virtual project.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* mlib-tgt-specific-vxworks.adb: Minor reformatting.
2011-11-23 Thomas Quinot <quinot@adacore.com>
* Make-generated.in (Sdefault.Target_Name): Set to
$(target_noncanonical) instead of $(target) for consistency.
From-SVN: r181668
2011-11-23 14:51:23 +01:00
|
|
|
do
|
|
|
|
B := B + 1;
|
|
|
|
end return;
|
2011-08-29 16:19:32 +02:00
|
|
|
end Iterate;
|
|
|
|
|
2010-10-25 15:50:29 +02:00
|
|
|
----------
|
|
|
|
-- Last --
|
|
|
|
----------
|
|
|
|
|
|
|
|
function Last (Container : Vector) return Cursor is
|
|
|
|
begin
|
|
|
|
if Is_Empty (Container) then
|
|
|
|
return No_Element;
|
[multiple changes]
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
package spec.
* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
while raising PE.
From-SVN: r178245
2011-08-29 16:25:19 +02:00
|
|
|
else
|
|
|
|
return (Container'Unrestricted_Access, Container.Last);
|
2010-10-25 15:50:29 +02:00
|
|
|
end if;
|
|
|
|
end Last;
|
|
|
|
|
2011-08-29 16:19:32 +02:00
|
|
|
function Last (Object : Iterator) return Cursor is
|
|
|
|
begin
|
2011-12-12 12:28:03 +01:00
|
|
|
-- The value of the iterator object's Index component influences the
|
|
|
|
-- behavior of the Last (and First) selector function.
|
|
|
|
|
|
|
|
-- When the Index component is No_Index, this means the iterator object
|
|
|
|
-- was constructed without a start expression, in which case the
|
|
|
|
-- (reverse) iteration starts from the (logical) beginning of the entire
|
|
|
|
-- sequence (corresponding to Container.Last, for a reverse iterator).
|
|
|
|
|
|
|
|
-- Otherwise, this is iteration over a partial sequence of items. When
|
|
|
|
-- the Index component is not No_Index, the iterator object was
|
|
|
|
-- constructed with a start expression, that specifies the position from
|
|
|
|
-- which the (reverse) partial iteration begins.
|
|
|
|
|
|
|
|
if Object.Index = No_Index then
|
|
|
|
return Last (Object.Container.all);
|
[multiple changes]
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
package spec.
* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
while raising PE.
From-SVN: r178245
2011-08-29 16:25:19 +02:00
|
|
|
else
|
2011-12-12 12:28:03 +01:00
|
|
|
return Cursor'(Object.Container, Object.Index);
|
2011-08-29 16:19:32 +02:00
|
|
|
end if;
|
|
|
|
end Last;
|
|
|
|
|
2010-10-25 15:50:29 +02:00
|
|
|
------------------
|
|
|
|
-- Last_Element --
|
|
|
|
------------------
|
|
|
|
|
|
|
|
function Last_Element (Container : Vector) return Element_Type is
|
|
|
|
begin
|
|
|
|
if Container.Last = No_Index then
|
|
|
|
raise Constraint_Error with "Container is empty";
|
[multiple changes]
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
package spec.
* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
while raising PE.
From-SVN: r178245
2011-08-29 16:25:19 +02:00
|
|
|
else
|
|
|
|
return Container.Elements (Container.Length);
|
2010-10-25 15:50:29 +02:00
|
|
|
end if;
|
|
|
|
end Last_Element;
|
|
|
|
|
|
|
|
----------------
|
|
|
|
-- Last_Index --
|
|
|
|
----------------
|
|
|
|
|
|
|
|
function Last_Index (Container : Vector) return Extended_Index is
|
|
|
|
begin
|
|
|
|
return Container.Last;
|
|
|
|
end Last_Index;
|
|
|
|
|
|
|
|
------------
|
|
|
|
-- Length --
|
|
|
|
------------
|
|
|
|
|
|
|
|
function Length (Container : Vector) return Count_Type is
|
|
|
|
L : constant Index_Type'Base := Container.Last;
|
|
|
|
F : constant Index_Type := Index_Type'First;
|
|
|
|
|
|
|
|
begin
|
|
|
|
-- The base range of the index type (Index_Type'Base) might not include
|
|
|
|
-- all values for length (Count_Type). Contrariwise, the index type
|
|
|
|
-- might include values outside the range of length. Hence we use
|
|
|
|
-- whatever type is wider for intermediate values when calculating
|
|
|
|
-- length. Note that no matter what the index type is, the maximum
|
|
|
|
-- length to which a vector is allowed to grow is always the minimum
|
|
|
|
-- of Count_Type'Last and (IT'Last - IT'First + 1).
|
|
|
|
|
|
|
|
-- For example, an Index_Type with range -127 .. 127 is only guaranteed
|
|
|
|
-- to have a base range of -128 .. 127, but the corresponding vector
|
|
|
|
-- would have lengths in the range 0 .. 255. In this case we would need
|
|
|
|
-- to use Count_Type'Base for intermediate values.
|
|
|
|
|
|
|
|
-- Another case would be the index range -2**63 + 1 .. -2**63 + 10. The
|
|
|
|
-- vector would have a maximum length of 10, but the index values lie
|
|
|
|
-- outside the range of Count_Type (which is only 32 bits). In this
|
|
|
|
-- case we would need to use Index_Type'Base for intermediate values.
|
|
|
|
|
|
|
|
if Count_Type'Base'Last >= Index_Type'Pos (Index_Type'Base'Last) then
|
|
|
|
return Count_Type'Base (L) - Count_Type'Base (F) + 1;
|
|
|
|
else
|
|
|
|
return Count_Type (L - F + 1);
|
|
|
|
end if;
|
|
|
|
end Length;
|
|
|
|
|
|
|
|
----------
|
|
|
|
-- Move --
|
|
|
|
----------
|
|
|
|
|
|
|
|
procedure Move
|
|
|
|
(Target : in out Vector;
|
|
|
|
Source : in out Vector)
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
if Target'Address = Source'Address then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Target.Capacity < Source.Length then
|
|
|
|
raise Capacity_Error -- ???
|
|
|
|
with "Target capacity is less than Source length";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Target.Busy > 0 then
|
|
|
|
raise Program_Error with
|
|
|
|
"attempt to tamper with cursors (Target is busy)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Source.Busy > 0 then
|
|
|
|
raise Program_Error with
|
|
|
|
"attempt to tamper with cursors (Source is busy)";
|
|
|
|
end if;
|
|
|
|
|
[multiple changes]
2011-12-02 Matthew Heaney <heaney@adacore.com>
* a-coormu.ads, a-ciormu.ads: Declare iterator factory function.
* a-ciormu.adb, a-ciormu.adb (Iterator): Declare concrete
Iterator type.
(Finalize): Decrement busy counter.
(First, Last): Cursor return value depends on iterator node value.
(Iterate): Use start position as iterator node value.
(Next, Previous): Forward to corresponding cursor-based operation.
2011-12-02 Robert Dewar <dewar@adacore.com>
* a-cborma.adb, a-cbhama.adb, a-cbdlli.adb, a-cbmutr.adb,
a-cbhase.adb, a-cdlili.adb, a-cihama.adb, a-ciorse.adb, a-cidlli.adb,
a-cimutr.adb, a-cihase.adb, a-cohama.adb, a-cborse.adb,
a-ciorma.adb, a-cobove.adb: Minor reformatting.
From-SVN: r181912
2011-12-02 15:36:31 +01:00
|
|
|
-- Clear Target now, in case element assignment fails
|
|
|
|
|
2010-10-25 15:50:29 +02:00
|
|
|
Target.Last := No_Index;
|
|
|
|
|
|
|
|
Target.Elements (1 .. Source.Length) :=
|
|
|
|
Source.Elements (1 .. Source.Length);
|
|
|
|
|
|
|
|
Target.Last := Source.Last;
|
|
|
|
Source.Last := No_Index;
|
|
|
|
end Move;
|
|
|
|
|
|
|
|
----------
|
|
|
|
-- Next --
|
|
|
|
----------
|
|
|
|
|
|
|
|
function Next (Position : Cursor) return Cursor is
|
|
|
|
begin
|
|
|
|
if Position.Container = null then
|
|
|
|
return No_Element;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Position.Index < Position.Container.Last then
|
|
|
|
return (Position.Container, Position.Index + 1);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return No_Element;
|
|
|
|
end Next;
|
|
|
|
|
2011-08-29 16:19:32 +02:00
|
|
|
function Next (Object : Iterator; Position : Cursor) return Cursor is
|
|
|
|
begin
|
2011-12-12 12:28:03 +01:00
|
|
|
if Position.Container = null then
|
|
|
|
return No_Element;
|
2011-08-29 16:19:32 +02:00
|
|
|
end if;
|
2011-12-12 12:28:03 +01:00
|
|
|
|
|
|
|
if Position.Container /= Object.Container then
|
|
|
|
raise Program_Error with
|
|
|
|
"Position cursor of Next designates wrong vector";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return Next (Position);
|
2011-08-29 16:19:32 +02:00
|
|
|
end Next;
|
2010-10-25 15:50:29 +02:00
|
|
|
|
|
|
|
procedure Next (Position : in out Cursor) is
|
|
|
|
begin
|
|
|
|
if Position.Container = null then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Position.Index < Position.Container.Last then
|
|
|
|
Position.Index := Position.Index + 1;
|
|
|
|
else
|
|
|
|
Position := No_Element;
|
|
|
|
end if;
|
|
|
|
end Next;
|
|
|
|
|
|
|
|
-------------
|
|
|
|
-- Prepend --
|
|
|
|
-------------
|
|
|
|
|
|
|
|
procedure Prepend (Container : in out Vector; New_Item : Vector) is
|
|
|
|
begin
|
|
|
|
Insert (Container, Index_Type'First, New_Item);
|
|
|
|
end Prepend;
|
|
|
|
|
|
|
|
procedure Prepend
|
|
|
|
(Container : in out Vector;
|
|
|
|
New_Item : Element_Type;
|
|
|
|
Count : Count_Type := 1)
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
Insert (Container,
|
|
|
|
Index_Type'First,
|
|
|
|
New_Item,
|
|
|
|
Count);
|
|
|
|
end Prepend;
|
|
|
|
|
|
|
|
--------------
|
|
|
|
-- Previous --
|
|
|
|
--------------
|
|
|
|
|
|
|
|
procedure Previous (Position : in out Cursor) is
|
|
|
|
begin
|
|
|
|
if Position.Container = null then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Position.Index > Index_Type'First then
|
|
|
|
Position.Index := Position.Index - 1;
|
|
|
|
else
|
|
|
|
Position := No_Element;
|
|
|
|
end if;
|
|
|
|
end Previous;
|
|
|
|
|
|
|
|
function Previous (Position : Cursor) return Cursor is
|
|
|
|
begin
|
|
|
|
if Position.Container = null then
|
|
|
|
return No_Element;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Position.Index > Index_Type'First then
|
|
|
|
return (Position.Container, Position.Index - 1);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return No_Element;
|
|
|
|
end Previous;
|
|
|
|
|
2011-08-29 16:19:32 +02:00
|
|
|
function Previous (Object : Iterator; Position : Cursor) return Cursor is
|
|
|
|
begin
|
2011-12-12 12:28:03 +01:00
|
|
|
if Position.Container = null then
|
2011-08-29 16:19:32 +02:00
|
|
|
return No_Element;
|
|
|
|
end if;
|
2011-12-12 12:28:03 +01:00
|
|
|
|
|
|
|
if Position.Container /= Object.Container then
|
|
|
|
raise Program_Error with
|
|
|
|
"Position cursor of Previous designates wrong vector";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return Previous (Position);
|
2011-08-29 16:19:32 +02:00
|
|
|
end Previous;
|
|
|
|
|
2010-10-25 15:50:29 +02:00
|
|
|
-------------------
|
|
|
|
-- Query_Element --
|
|
|
|
-------------------
|
|
|
|
|
|
|
|
procedure Query_Element
|
|
|
|
(Container : Vector;
|
|
|
|
Index : Index_Type;
|
|
|
|
Process : not null access procedure (Element : Element_Type))
|
|
|
|
is
|
|
|
|
V : Vector renames Container'Unrestricted_Access.all;
|
|
|
|
B : Natural renames V.Busy;
|
|
|
|
L : Natural renames V.Lock;
|
|
|
|
|
|
|
|
begin
|
|
|
|
if Index > Container.Last then
|
|
|
|
raise Constraint_Error with "Index is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
B := B + 1;
|
|
|
|
L := L + 1;
|
|
|
|
|
|
|
|
begin
|
|
|
|
Process (V.Elements (To_Array_Index (Index)));
|
|
|
|
exception
|
|
|
|
when others =>
|
|
|
|
L := L - 1;
|
|
|
|
B := B - 1;
|
|
|
|
raise;
|
|
|
|
end;
|
|
|
|
|
|
|
|
L := L - 1;
|
|
|
|
B := B - 1;
|
|
|
|
end Query_Element;
|
|
|
|
|
|
|
|
procedure Query_Element
|
|
|
|
(Position : Cursor;
|
|
|
|
Process : not null access procedure (Element : Element_Type))
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
if Position.Container = null then
|
|
|
|
raise Constraint_Error with "Position cursor has no element";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Query_Element (Position.Container.all, Position.Index, Process);
|
|
|
|
end Query_Element;
|
|
|
|
|
|
|
|
----------
|
|
|
|
-- Read --
|
|
|
|
----------
|
|
|
|
|
|
|
|
procedure Read
|
|
|
|
(Stream : not null access Root_Stream_Type'Class;
|
|
|
|
Container : out Vector)
|
|
|
|
is
|
|
|
|
Length : Count_Type'Base;
|
|
|
|
Last : Index_Type'Base := No_Index;
|
|
|
|
|
|
|
|
begin
|
|
|
|
Clear (Container);
|
|
|
|
|
|
|
|
Count_Type'Base'Read (Stream, Length);
|
|
|
|
|
|
|
|
Reserve_Capacity (Container, Capacity => Length);
|
|
|
|
|
|
|
|
for Idx in Count_Type range 1 .. Length loop
|
|
|
|
Last := Last + 1;
|
|
|
|
Element_Type'Read (Stream, Container.Elements (Idx));
|
|
|
|
Container.Last := Last;
|
|
|
|
end loop;
|
|
|
|
end Read;
|
|
|
|
|
|
|
|
procedure Read
|
|
|
|
(Stream : not null access Root_Stream_Type'Class;
|
|
|
|
Position : out Cursor)
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
raise Program_Error with "attempt to stream vector cursor";
|
|
|
|
end Read;
|
|
|
|
|
2011-08-29 16:19:32 +02:00
|
|
|
procedure Read
|
|
|
|
(Stream : not null access Root_Stream_Type'Class;
|
|
|
|
Item : out Reference_Type)
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
raise Program_Error with "attempt to stream reference";
|
|
|
|
end Read;
|
|
|
|
|
|
|
|
procedure Read
|
|
|
|
(Stream : not null access Root_Stream_Type'Class;
|
|
|
|
Item : out Constant_Reference_Type)
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
raise Program_Error with "attempt to stream reference";
|
|
|
|
end Read;
|
|
|
|
|
|
|
|
---------------
|
|
|
|
-- Reference --
|
|
|
|
---------------
|
|
|
|
|
[multiple changes]
2012-01-10 Pascal Obry <obry@adacore.com>
* prj-nmsc.adb (Check_Library_Attributes): Kill check for object/source
directories for aggregate libraries.
2012-01-10 Matthew Heaney <heaney@adacore.com>
* a-cdlili.adb, a-cdlili.ads, a-cihama.adb, a-cihama.ads, a-coinve.adb,
a-coinve.ads, a-ciorse.adb, a-ciorse.ads, a-coorma.adb, a-coorma.ads,
a-cborma.adb, a-cborma.ads, a-cidlli.adb, a-cidlli.ads, a-cimutr.adb,
a-cimutr.ads, a-cihase.adb, a-cihase.ads, a-cohama.adb, a-cohama.ads,
a-coorse.adb, a-coorse.ads, a-cbhama.adb, a-cbhama.ads, a-cborse.adb,
a-cborse.ads, a-comutr.adb, a-comutr.ads, a-ciorma.adb, a-cobove.adb,
a-ciorma.ads, a-cobove.ads, a-convec.adb, a-convec.ads, a-cohase.adb,
a-cohase.ads, a-cbdlli.adb, a-cbdlli.ads, a-cbmutr.adb, a-cbmutr.ads,
a-cbhase.adb, a-cbhase.ads (Reference, Constant_Reference): Declare
container parameter as aliased in/in out.
Code clean ups.
2012-01-10 Bob Duff <duff@adacore.com>
* s-os_lib.ads: Improve comment.
2012-01-10 Geert Bosch <bosch@adacore.com>
* s-gearop.adb (Forward_Eliminate): Avoid improper aliasing
for complex Scalar.
From-SVN: r183060
2012-01-10 12:06:44 +01:00
|
|
|
function Reference
|
|
|
|
(Container : aliased in out Vector;
|
|
|
|
Position : Cursor) return Reference_Type
|
[multiple changes]
2011-12-02 Matthew Heaney <heaney@adacore.com>
* a-coormu.ads, a-ciormu.ads: Declare iterator factory function.
* a-ciormu.adb, a-ciormu.adb (Iterator): Declare concrete
Iterator type.
(Finalize): Decrement busy counter.
(First, Last): Cursor return value depends on iterator node value.
(Iterate): Use start position as iterator node value.
(Next, Previous): Forward to corresponding cursor-based operation.
2011-12-02 Robert Dewar <dewar@adacore.com>
* a-cborma.adb, a-cbhama.adb, a-cbdlli.adb, a-cbmutr.adb,
a-cbhase.adb, a-cdlili.adb, a-cihama.adb, a-ciorse.adb, a-cidlli.adb,
a-cimutr.adb, a-cihase.adb, a-cohama.adb, a-cborse.adb,
a-ciorma.adb, a-cobove.adb: Minor reformatting.
From-SVN: r181912
2011-12-02 15:36:31 +01:00
|
|
|
is
|
2011-08-29 16:19:32 +02:00
|
|
|
begin
|
|
|
|
if Position.Container = null then
|
|
|
|
raise Constraint_Error with "Position cursor has no element";
|
|
|
|
end if;
|
|
|
|
|
[multiple changes]
2012-01-10 Pascal Obry <obry@adacore.com>
* prj-nmsc.adb (Check_Library_Attributes): Kill check for object/source
directories for aggregate libraries.
2012-01-10 Matthew Heaney <heaney@adacore.com>
* a-cdlili.adb, a-cdlili.ads, a-cihama.adb, a-cihama.ads, a-coinve.adb,
a-coinve.ads, a-ciorse.adb, a-ciorse.ads, a-coorma.adb, a-coorma.ads,
a-cborma.adb, a-cborma.ads, a-cidlli.adb, a-cidlli.ads, a-cimutr.adb,
a-cimutr.ads, a-cihase.adb, a-cihase.ads, a-cohama.adb, a-cohama.ads,
a-coorse.adb, a-coorse.ads, a-cbhama.adb, a-cbhama.ads, a-cborse.adb,
a-cborse.ads, a-comutr.adb, a-comutr.ads, a-ciorma.adb, a-cobove.adb,
a-ciorma.ads, a-cobove.ads, a-convec.adb, a-convec.ads, a-cohase.adb,
a-cohase.ads, a-cbdlli.adb, a-cbdlli.ads, a-cbmutr.adb, a-cbmutr.ads,
a-cbhase.adb, a-cbhase.ads (Reference, Constant_Reference): Declare
container parameter as aliased in/in out.
Code clean ups.
2012-01-10 Bob Duff <duff@adacore.com>
* s-os_lib.ads: Improve comment.
2012-01-10 Geert Bosch <bosch@adacore.com>
* s-gearop.adb (Forward_Eliminate): Avoid improper aliasing
for complex Scalar.
From-SVN: r183060
2012-01-10 12:06:44 +01:00
|
|
|
if Position.Container /= Container'Unrestricted_Access then
|
|
|
|
raise Program_Error with "Position cursor denotes wrong container";
|
2011-08-29 16:19:32 +02:00
|
|
|
end if;
|
|
|
|
|
|
|
|
if Position.Index > Position.Container.Last then
|
|
|
|
raise Constraint_Error with "Position cursor is out of range";
|
|
|
|
end if;
|
|
|
|
|
[multiple changes]
2012-01-10 Pascal Obry <obry@adacore.com>
* prj-nmsc.adb (Check_Library_Attributes): Kill check for object/source
directories for aggregate libraries.
2012-01-10 Matthew Heaney <heaney@adacore.com>
* a-cdlili.adb, a-cdlili.ads, a-cihama.adb, a-cihama.ads, a-coinve.adb,
a-coinve.ads, a-ciorse.adb, a-ciorse.ads, a-coorma.adb, a-coorma.ads,
a-cborma.adb, a-cborma.ads, a-cidlli.adb, a-cidlli.ads, a-cimutr.adb,
a-cimutr.ads, a-cihase.adb, a-cihase.ads, a-cohama.adb, a-cohama.ads,
a-coorse.adb, a-coorse.ads, a-cbhama.adb, a-cbhama.ads, a-cborse.adb,
a-cborse.ads, a-comutr.adb, a-comutr.ads, a-ciorma.adb, a-cobove.adb,
a-ciorma.ads, a-cobove.ads, a-convec.adb, a-convec.ads, a-cohase.adb,
a-cohase.ads, a-cbdlli.adb, a-cbdlli.ads, a-cbmutr.adb, a-cbmutr.ads,
a-cbhase.adb, a-cbhase.ads (Reference, Constant_Reference): Declare
container parameter as aliased in/in out.
Code clean ups.
2012-01-10 Bob Duff <duff@adacore.com>
* s-os_lib.ads: Improve comment.
2012-01-10 Geert Bosch <bosch@adacore.com>
* s-gearop.adb (Forward_Eliminate): Avoid improper aliasing
for complex Scalar.
From-SVN: r183060
2012-01-10 12:06:44 +01:00
|
|
|
declare
|
|
|
|
A : Elements_Array renames Container.Elements;
|
|
|
|
I : constant Count_Type := To_Array_Index (Position.Index);
|
|
|
|
begin
|
|
|
|
return (Element => A (I)'Access);
|
|
|
|
end;
|
2011-08-29 16:19:32 +02:00
|
|
|
end Reference;
|
|
|
|
|
[multiple changes]
2011-12-02 Matthew Heaney <heaney@adacore.com>
* a-coormu.ads, a-ciormu.ads: Declare iterator factory function.
* a-ciormu.adb, a-ciormu.adb (Iterator): Declare concrete
Iterator type.
(Finalize): Decrement busy counter.
(First, Last): Cursor return value depends on iterator node value.
(Iterate): Use start position as iterator node value.
(Next, Previous): Forward to corresponding cursor-based operation.
2011-12-02 Robert Dewar <dewar@adacore.com>
* a-cborma.adb, a-cbhama.adb, a-cbdlli.adb, a-cbmutr.adb,
a-cbhase.adb, a-cdlili.adb, a-cihama.adb, a-ciorse.adb, a-cidlli.adb,
a-cimutr.adb, a-cihase.adb, a-cohama.adb, a-cborse.adb,
a-ciorma.adb, a-cobove.adb: Minor reformatting.
From-SVN: r181912
2011-12-02 15:36:31 +01:00
|
|
|
function Reference
|
[multiple changes]
2012-01-10 Pascal Obry <obry@adacore.com>
* prj-nmsc.adb (Check_Library_Attributes): Kill check for object/source
directories for aggregate libraries.
2012-01-10 Matthew Heaney <heaney@adacore.com>
* a-cdlili.adb, a-cdlili.ads, a-cihama.adb, a-cihama.ads, a-coinve.adb,
a-coinve.ads, a-ciorse.adb, a-ciorse.ads, a-coorma.adb, a-coorma.ads,
a-cborma.adb, a-cborma.ads, a-cidlli.adb, a-cidlli.ads, a-cimutr.adb,
a-cimutr.ads, a-cihase.adb, a-cihase.ads, a-cohama.adb, a-cohama.ads,
a-coorse.adb, a-coorse.ads, a-cbhama.adb, a-cbhama.ads, a-cborse.adb,
a-cborse.ads, a-comutr.adb, a-comutr.ads, a-ciorma.adb, a-cobove.adb,
a-ciorma.ads, a-cobove.ads, a-convec.adb, a-convec.ads, a-cohase.adb,
a-cohase.ads, a-cbdlli.adb, a-cbdlli.ads, a-cbmutr.adb, a-cbmutr.ads,
a-cbhase.adb, a-cbhase.ads (Reference, Constant_Reference): Declare
container parameter as aliased in/in out.
Code clean ups.
2012-01-10 Bob Duff <duff@adacore.com>
* s-os_lib.ads: Improve comment.
2012-01-10 Geert Bosch <bosch@adacore.com>
* s-gearop.adb (Forward_Eliminate): Avoid improper aliasing
for complex Scalar.
From-SVN: r183060
2012-01-10 12:06:44 +01:00
|
|
|
(Container : aliased in out Vector;
|
|
|
|
Index : Index_Type) return Reference_Type
|
[multiple changes]
2011-12-02 Matthew Heaney <heaney@adacore.com>
* a-coormu.ads, a-ciormu.ads: Declare iterator factory function.
* a-ciormu.adb, a-ciormu.adb (Iterator): Declare concrete
Iterator type.
(Finalize): Decrement busy counter.
(First, Last): Cursor return value depends on iterator node value.
(Iterate): Use start position as iterator node value.
(Next, Previous): Forward to corresponding cursor-based operation.
2011-12-02 Robert Dewar <dewar@adacore.com>
* a-cborma.adb, a-cbhama.adb, a-cbdlli.adb, a-cbmutr.adb,
a-cbhase.adb, a-cdlili.adb, a-cihama.adb, a-ciorse.adb, a-cidlli.adb,
a-cimutr.adb, a-cihase.adb, a-cohama.adb, a-cborse.adb,
a-ciorma.adb, a-cobove.adb: Minor reformatting.
From-SVN: r181912
2011-12-02 15:36:31 +01:00
|
|
|
is
|
2011-08-29 16:19:32 +02:00
|
|
|
begin
|
[multiple changes]
2012-01-10 Pascal Obry <obry@adacore.com>
* prj-nmsc.adb (Check_Library_Attributes): Kill check for object/source
directories for aggregate libraries.
2012-01-10 Matthew Heaney <heaney@adacore.com>
* a-cdlili.adb, a-cdlili.ads, a-cihama.adb, a-cihama.ads, a-coinve.adb,
a-coinve.ads, a-ciorse.adb, a-ciorse.ads, a-coorma.adb, a-coorma.ads,
a-cborma.adb, a-cborma.ads, a-cidlli.adb, a-cidlli.ads, a-cimutr.adb,
a-cimutr.ads, a-cihase.adb, a-cihase.ads, a-cohama.adb, a-cohama.ads,
a-coorse.adb, a-coorse.ads, a-cbhama.adb, a-cbhama.ads, a-cborse.adb,
a-cborse.ads, a-comutr.adb, a-comutr.ads, a-ciorma.adb, a-cobove.adb,
a-ciorma.ads, a-cobove.ads, a-convec.adb, a-convec.ads, a-cohase.adb,
a-cohase.ads, a-cbdlli.adb, a-cbdlli.ads, a-cbmutr.adb, a-cbmutr.ads,
a-cbhase.adb, a-cbhase.ads (Reference, Constant_Reference): Declare
container parameter as aliased in/in out.
Code clean ups.
2012-01-10 Bob Duff <duff@adacore.com>
* s-os_lib.ads: Improve comment.
2012-01-10 Geert Bosch <bosch@adacore.com>
* s-gearop.adb (Forward_Eliminate): Avoid improper aliasing
for complex Scalar.
From-SVN: r183060
2012-01-10 12:06:44 +01:00
|
|
|
if Index > Container.Last then
|
2011-08-29 16:19:32 +02:00
|
|
|
raise Constraint_Error with "Index is out of range";
|
|
|
|
end if;
|
[multiple changes]
2012-01-10 Pascal Obry <obry@adacore.com>
* prj-nmsc.adb (Check_Library_Attributes): Kill check for object/source
directories for aggregate libraries.
2012-01-10 Matthew Heaney <heaney@adacore.com>
* a-cdlili.adb, a-cdlili.ads, a-cihama.adb, a-cihama.ads, a-coinve.adb,
a-coinve.ads, a-ciorse.adb, a-ciorse.ads, a-coorma.adb, a-coorma.ads,
a-cborma.adb, a-cborma.ads, a-cidlli.adb, a-cidlli.ads, a-cimutr.adb,
a-cimutr.ads, a-cihase.adb, a-cihase.ads, a-cohama.adb, a-cohama.ads,
a-coorse.adb, a-coorse.ads, a-cbhama.adb, a-cbhama.ads, a-cborse.adb,
a-cborse.ads, a-comutr.adb, a-comutr.ads, a-ciorma.adb, a-cobove.adb,
a-ciorma.ads, a-cobove.ads, a-convec.adb, a-convec.ads, a-cohase.adb,
a-cohase.ads, a-cbdlli.adb, a-cbdlli.ads, a-cbmutr.adb, a-cbmutr.ads,
a-cbhase.adb, a-cbhase.ads (Reference, Constant_Reference): Declare
container parameter as aliased in/in out.
Code clean ups.
2012-01-10 Bob Duff <duff@adacore.com>
* s-os_lib.ads: Improve comment.
2012-01-10 Geert Bosch <bosch@adacore.com>
* s-gearop.adb (Forward_Eliminate): Avoid improper aliasing
for complex Scalar.
From-SVN: r183060
2012-01-10 12:06:44 +01:00
|
|
|
|
|
|
|
declare
|
|
|
|
A : Elements_Array renames Container.Elements;
|
|
|
|
I : constant Count_Type := To_Array_Index (Index);
|
|
|
|
begin
|
|
|
|
return (Element => A (I)'Access);
|
|
|
|
end;
|
2011-08-29 16:19:32 +02:00
|
|
|
end Reference;
|
|
|
|
|
2010-10-25 15:50:29 +02:00
|
|
|
---------------------
|
|
|
|
-- Replace_Element --
|
|
|
|
---------------------
|
|
|
|
|
|
|
|
procedure Replace_Element
|
|
|
|
(Container : in out Vector;
|
|
|
|
Index : Index_Type;
|
|
|
|
New_Item : Element_Type)
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
if Index > Container.Last then
|
|
|
|
raise Constraint_Error with "Index is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Container.Lock > 0 then
|
|
|
|
raise Program_Error with
|
|
|
|
"attempt to tamper with elements (vector is locked)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Container.Elements (To_Array_Index (Index)) := New_Item;
|
|
|
|
end Replace_Element;
|
|
|
|
|
|
|
|
procedure Replace_Element
|
|
|
|
(Container : in out Vector;
|
|
|
|
Position : Cursor;
|
|
|
|
New_Item : Element_Type)
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
if Position.Container = null then
|
|
|
|
raise Constraint_Error with "Position cursor has no element";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Position.Container /= Container'Unrestricted_Access then
|
|
|
|
raise Program_Error with "Position cursor denotes wrong container";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Position.Index > Container.Last then
|
|
|
|
raise Constraint_Error with "Position cursor is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Container.Lock > 0 then
|
|
|
|
raise Program_Error with
|
|
|
|
"attempt to tamper with elements (vector is locked)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Container.Elements (To_Array_Index (Position.Index)) := New_Item;
|
|
|
|
end Replace_Element;
|
|
|
|
|
|
|
|
----------------------
|
|
|
|
-- Reserve_Capacity --
|
|
|
|
----------------------
|
|
|
|
|
|
|
|
procedure Reserve_Capacity
|
|
|
|
(Container : in out Vector;
|
|
|
|
Capacity : Count_Type)
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
if Capacity > Container.Capacity then
|
|
|
|
raise Constraint_Error with "Capacity is out of range";
|
|
|
|
end if;
|
|
|
|
end Reserve_Capacity;
|
|
|
|
|
|
|
|
----------------------
|
|
|
|
-- Reverse_Elements --
|
|
|
|
----------------------
|
|
|
|
|
|
|
|
procedure Reverse_Elements (Container : in out Vector) is
|
[multiple changes]
2012-02-08 Robert Dewar <dewar@adacore.com>
* a-coinve.adb, sem_util.adb, sem_ch8.adb, a-cobove.adb,
a-convec.adb: Minor reformatting and code reorganization.
2012-02-08 Steve Baird <baird@adacore.com>
* sem_cat.adb (In_Preelaborated_Unit): A child
unit instantiation does not inherit preelaboration requirements
from its parent.
2012-02-08 Gary Dismukes <dismukes@adacore.com>
* aspects.ads (type Aspect_Id): Add Aspect_Simple_Storage_Pool.
(Impl_Defined_Aspects): Add entry for Aspect_Simple_Storage_Pool.
(Aspect_Argument): Add Name entry for Aspect_Simple_Storage_Pool.
(Aspect_Names): Add entry for Aspect_Simple_Storage_Pool.
* aspects.adb (Canonical_Aspect): Add entry for
Aspect_Simple_Storage_Pool.
* exp_attr.adb (Expand_N_Attribute_Reference): Handle case of
Attribute_Simple_Storage_Pool in the same way as Storage_Pool
(add conversion, analyze/resolve). For the Storage_Size attribute,
for the simple pool case, locate and use the simple pool type's
Storage_Size function (if any), otherwise evaluate to zero.
* exp_ch4.adb (Expand_N_Allocator): In the case of an allocator
for an access type with an associated simple storage pool,
locate and use the pool type's Allocate.
* exp_intr.adb (Expand_Unc_Deallocation): In the case where the
access type has a simple storage pool, locate the pool type's
Deallocate procedure (if present) and use it as the procedure
to call on the Free operation.
* freeze.adb (Freeze_Entity): In the case of a full type for
a private type defined with pragma Simple_Storage_Pool, check
that the full type is also appropriate for the pragma. For
a simple storage pool type, validate that the operations
Allocate, Deallocate (if present), and Storage_Size
(if present) are defined with appropriate expected profiles.
(Validate_Simple_Pool_Op_Formal): New procedure
(Validate_Simple_Pool_Operation): New procedure Add with and
use of Rtsfind.
* par-prag.adb: Add Pragma_Simple_Storage_Pool to case statement
(no action required).
* sem_attr.adb (Analyze_Attribute): For the case of the
Storage_Pool attribute, give a warning if the prefix type has an
associated simple storage pool, and rewrite the attribute as a
raise of Program_Error. In the case of the Simple_Storage_Pool
attribute, check that the prefix type has an associated simple
storage pool, and set the attribute type to the pool's type.
* sem_ch13.adb (Analyze_Aspect_Specifications): Add
Aspect_Simple_Storage_Pool case choice.
(Analyze_Attribute_Definition_Clause): Add
Aspect_Simple_Storage_Pool to case for Ignore_Rep_Clauses
(no action). Add handling for Simple_Storage_Pool attribute
definition, requiring the name to denote a simple storage pool
object.
(Check_Aspect_At_Freeze_Point): For a simple storage pool
aspect, set the type to that of the name specified for the aspect.
* sem_prag.adb (Analyze_Pragma): Add handling for pragma
Simple_Storage_Pool, requiring that it applies to a library-level
type declared in a package declaration that is a limited private
or limited record type.
* sem_res.adb (Resolve_Allocator): Flag an attempt to call a
build-in-place function in an allocator for an access type with
a simple storage pool as unsupported.
* snames.ads-tmpl: Add Name_Simple_Storage_Pool.
(type Attribute_Id): Add Attribute_Simple_Storage_Pool.
(type Pragma_Id): Add Pragma_Simple_Storage_Pool.
* snames.adb-tmpl (Get_Pragma_Id): Handle case of
Name_Simple_Storage_Pool.
(Is_Pragma_Name): Return True for Name_Simple_Storage_Pool.
2012-02-08 Cyrille Comar <comar@adacore.com>
* projects.texi: Clarify doc for interfaces.
From-SVN: r183997
2012-02-08 10:27:17 +01:00
|
|
|
E : Elements_Array renames Container.Elements;
|
|
|
|
Idx : Count_Type;
|
|
|
|
Jdx : Count_Type;
|
2010-10-25 15:50:29 +02:00
|
|
|
|
|
|
|
begin
|
|
|
|
if Container.Length <= 1 then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
2012-01-30 13:16:12 +01:00
|
|
|
-- The exception behavior for the vector container must match that for
|
|
|
|
-- the list container, so we check for cursor tampering here (which will
|
|
|
|
-- catch more things) instead of for element tampering (which will catch
|
|
|
|
-- fewer things). It's true that the elements of this vector container
|
|
|
|
-- could be safely moved around while (say) an iteration is taking place
|
[multiple changes]
2012-02-08 Robert Dewar <dewar@adacore.com>
* a-coinve.adb, sem_util.adb, sem_ch8.adb, a-cobove.adb,
a-convec.adb: Minor reformatting and code reorganization.
2012-02-08 Steve Baird <baird@adacore.com>
* sem_cat.adb (In_Preelaborated_Unit): A child
unit instantiation does not inherit preelaboration requirements
from its parent.
2012-02-08 Gary Dismukes <dismukes@adacore.com>
* aspects.ads (type Aspect_Id): Add Aspect_Simple_Storage_Pool.
(Impl_Defined_Aspects): Add entry for Aspect_Simple_Storage_Pool.
(Aspect_Argument): Add Name entry for Aspect_Simple_Storage_Pool.
(Aspect_Names): Add entry for Aspect_Simple_Storage_Pool.
* aspects.adb (Canonical_Aspect): Add entry for
Aspect_Simple_Storage_Pool.
* exp_attr.adb (Expand_N_Attribute_Reference): Handle case of
Attribute_Simple_Storage_Pool in the same way as Storage_Pool
(add conversion, analyze/resolve). For the Storage_Size attribute,
for the simple pool case, locate and use the simple pool type's
Storage_Size function (if any), otherwise evaluate to zero.
* exp_ch4.adb (Expand_N_Allocator): In the case of an allocator
for an access type with an associated simple storage pool,
locate and use the pool type's Allocate.
* exp_intr.adb (Expand_Unc_Deallocation): In the case where the
access type has a simple storage pool, locate the pool type's
Deallocate procedure (if present) and use it as the procedure
to call on the Free operation.
* freeze.adb (Freeze_Entity): In the case of a full type for
a private type defined with pragma Simple_Storage_Pool, check
that the full type is also appropriate for the pragma. For
a simple storage pool type, validate that the operations
Allocate, Deallocate (if present), and Storage_Size
(if present) are defined with appropriate expected profiles.
(Validate_Simple_Pool_Op_Formal): New procedure
(Validate_Simple_Pool_Operation): New procedure Add with and
use of Rtsfind.
* par-prag.adb: Add Pragma_Simple_Storage_Pool to case statement
(no action required).
* sem_attr.adb (Analyze_Attribute): For the case of the
Storage_Pool attribute, give a warning if the prefix type has an
associated simple storage pool, and rewrite the attribute as a
raise of Program_Error. In the case of the Simple_Storage_Pool
attribute, check that the prefix type has an associated simple
storage pool, and set the attribute type to the pool's type.
* sem_ch13.adb (Analyze_Aspect_Specifications): Add
Aspect_Simple_Storage_Pool case choice.
(Analyze_Attribute_Definition_Clause): Add
Aspect_Simple_Storage_Pool to case for Ignore_Rep_Clauses
(no action). Add handling for Simple_Storage_Pool attribute
definition, requiring the name to denote a simple storage pool
object.
(Check_Aspect_At_Freeze_Point): For a simple storage pool
aspect, set the type to that of the name specified for the aspect.
* sem_prag.adb (Analyze_Pragma): Add handling for pragma
Simple_Storage_Pool, requiring that it applies to a library-level
type declared in a package declaration that is a limited private
or limited record type.
* sem_res.adb (Resolve_Allocator): Flag an attempt to call a
build-in-place function in an allocator for an access type with
a simple storage pool as unsupported.
* snames.ads-tmpl: Add Name_Simple_Storage_Pool.
(type Attribute_Id): Add Attribute_Simple_Storage_Pool.
(type Pragma_Id): Add Pragma_Simple_Storage_Pool.
* snames.adb-tmpl (Get_Pragma_Id): Handle case of
Name_Simple_Storage_Pool.
(Is_Pragma_Name): Return True for Name_Simple_Storage_Pool.
2012-02-08 Cyrille Comar <comar@adacore.com>
* projects.texi: Clarify doc for interfaces.
From-SVN: r183997
2012-02-08 10:27:17 +01:00
|
|
|
-- (iteration only increments the busy counter), and so technically
|
|
|
|
-- all we would need here is a test for element tampering (indicated
|
|
|
|
-- by the lock counter), that's simply an artifact of our array-based
|
2012-01-30 13:16:12 +01:00
|
|
|
-- implementation. Logically Reverse_Elements requires a check for
|
|
|
|
-- cursor tampering.
|
|
|
|
|
|
|
|
if Container.Busy > 0 then
|
2010-10-25 15:50:29 +02:00
|
|
|
raise Program_Error with
|
2012-01-30 13:16:12 +01:00
|
|
|
"attempt to tamper with cursors (vector is busy)";
|
2010-10-25 15:50:29 +02:00
|
|
|
end if;
|
|
|
|
|
|
|
|
Idx := 1;
|
|
|
|
Jdx := Container.Length;
|
|
|
|
while Idx < Jdx loop
|
|
|
|
declare
|
|
|
|
EI : constant Element_Type := E (Idx);
|
|
|
|
|
|
|
|
begin
|
|
|
|
E (Idx) := E (Jdx);
|
|
|
|
E (Jdx) := EI;
|
|
|
|
end;
|
|
|
|
|
|
|
|
Idx := Idx + 1;
|
|
|
|
Jdx := Jdx - 1;
|
|
|
|
end loop;
|
|
|
|
end Reverse_Elements;
|
|
|
|
|
|
|
|
------------------
|
|
|
|
-- Reverse_Find --
|
|
|
|
------------------
|
|
|
|
|
|
|
|
function Reverse_Find
|
|
|
|
(Container : Vector;
|
|
|
|
Item : Element_Type;
|
|
|
|
Position : Cursor := No_Element) return Cursor
|
|
|
|
is
|
|
|
|
Last : Index_Type'Base;
|
|
|
|
|
|
|
|
begin
|
|
|
|
if Position.Container /= null
|
|
|
|
and then Position.Container /= Container'Unrestricted_Access
|
|
|
|
then
|
|
|
|
raise Program_Error with "Position cursor denotes wrong container";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Last :=
|
|
|
|
(if Position.Container = null or else Position.Index > Container.Last
|
|
|
|
then Container.Last
|
|
|
|
else Position.Index);
|
|
|
|
|
|
|
|
for Indx in reverse Index_Type'First .. Last loop
|
|
|
|
if Container.Elements (To_Array_Index (Indx)) = Item then
|
|
|
|
return (Container'Unrestricted_Access, Indx);
|
|
|
|
end if;
|
|
|
|
end loop;
|
|
|
|
|
|
|
|
return No_Element;
|
|
|
|
end Reverse_Find;
|
|
|
|
|
|
|
|
------------------------
|
|
|
|
-- Reverse_Find_Index --
|
|
|
|
------------------------
|
|
|
|
|
|
|
|
function Reverse_Find_Index
|
|
|
|
(Container : Vector;
|
|
|
|
Item : Element_Type;
|
|
|
|
Index : Index_Type := Index_Type'Last) return Extended_Index
|
|
|
|
is
|
|
|
|
Last : constant Index_Type'Base :=
|
|
|
|
Index_Type'Min (Container.Last, Index);
|
|
|
|
|
|
|
|
begin
|
|
|
|
for Indx in reverse Index_Type'First .. Last loop
|
|
|
|
if Container.Elements (To_Array_Index (Indx)) = Item then
|
|
|
|
return Indx;
|
|
|
|
end if;
|
|
|
|
end loop;
|
|
|
|
|
|
|
|
return No_Index;
|
|
|
|
end Reverse_Find_Index;
|
|
|
|
|
|
|
|
---------------------
|
|
|
|
-- Reverse_Iterate --
|
|
|
|
---------------------
|
|
|
|
|
|
|
|
procedure Reverse_Iterate
|
|
|
|
(Container : Vector;
|
|
|
|
Process : not null access procedure (Position : Cursor))
|
|
|
|
is
|
|
|
|
V : Vector renames Container'Unrestricted_Access.all;
|
|
|
|
B : Natural renames V.Busy;
|
|
|
|
|
|
|
|
begin
|
|
|
|
B := B + 1;
|
|
|
|
|
|
|
|
begin
|
|
|
|
for Indx in reverse Index_Type'First .. Container.Last loop
|
|
|
|
Process (Cursor'(Container'Unrestricted_Access, Indx));
|
|
|
|
end loop;
|
|
|
|
exception
|
|
|
|
when others =>
|
|
|
|
B := B - 1;
|
|
|
|
raise;
|
|
|
|
end;
|
|
|
|
|
|
|
|
B := B - 1;
|
|
|
|
end Reverse_Iterate;
|
|
|
|
|
|
|
|
----------------
|
|
|
|
-- Set_Length --
|
|
|
|
----------------
|
|
|
|
|
|
|
|
procedure Set_Length (Container : in out Vector; Length : Count_Type) is
|
|
|
|
Count : constant Count_Type'Base := Container.Length - Length;
|
|
|
|
|
|
|
|
begin
|
|
|
|
-- Set_Length allows the user to set the length explicitly, instead of
|
|
|
|
-- implicitly as a side-effect of deletion or insertion. If the
|
|
|
|
-- requested length is less then the current length, this is equivalent
|
|
|
|
-- to deleting items from the back end of the vector. If the requested
|
|
|
|
-- length is greater than the current length, then this is equivalent to
|
|
|
|
-- inserting "space" (nonce items) at the end.
|
|
|
|
|
|
|
|
if Count >= 0 then
|
|
|
|
Container.Delete_Last (Count);
|
|
|
|
|
|
|
|
elsif Container.Last >= Index_Type'Last then
|
|
|
|
raise Constraint_Error with "vector is already at its maximum length";
|
|
|
|
|
|
|
|
else
|
|
|
|
Container.Insert_Space (Container.Last + 1, -Count);
|
|
|
|
end if;
|
|
|
|
end Set_Length;
|
|
|
|
|
|
|
|
----------
|
|
|
|
-- Swap --
|
|
|
|
----------
|
|
|
|
|
|
|
|
procedure Swap (Container : in out Vector; I, J : Index_Type) is
|
|
|
|
E : Elements_Array renames Container.Elements;
|
|
|
|
|
|
|
|
begin
|
|
|
|
if I > Container.Last then
|
|
|
|
raise Constraint_Error with "I index is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if J > Container.Last then
|
|
|
|
raise Constraint_Error with "J index is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if I = J then
|
|
|
|
return;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Container.Lock > 0 then
|
|
|
|
raise Program_Error with
|
|
|
|
"attempt to tamper with elements (vector is locked)";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
declare
|
|
|
|
EI_Copy : constant Element_Type := E (To_Array_Index (I));
|
|
|
|
begin
|
|
|
|
E (To_Array_Index (I)) := E (To_Array_Index (J));
|
|
|
|
E (To_Array_Index (J)) := EI_Copy;
|
|
|
|
end;
|
|
|
|
end Swap;
|
|
|
|
|
|
|
|
procedure Swap (Container : in out Vector; I, J : Cursor) is
|
|
|
|
begin
|
|
|
|
if I.Container = null then
|
|
|
|
raise Constraint_Error with "I cursor has no element";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if J.Container = null then
|
|
|
|
raise Constraint_Error with "J cursor has no element";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if I.Container /= Container'Unrestricted_Access then
|
|
|
|
raise Program_Error with "I cursor denotes wrong container";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if J.Container /= Container'Unrestricted_Access then
|
|
|
|
raise Program_Error with "J cursor denotes wrong container";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Swap (Container, I.Index, J.Index);
|
|
|
|
end Swap;
|
|
|
|
|
|
|
|
--------------------
|
|
|
|
-- To_Array_Index --
|
|
|
|
--------------------
|
|
|
|
|
|
|
|
function To_Array_Index (Index : Index_Type'Base) return Count_Type'Base is
|
|
|
|
Offset : Count_Type'Base;
|
|
|
|
|
|
|
|
begin
|
|
|
|
-- We know that
|
|
|
|
-- Index >= Index_Type'First
|
|
|
|
-- hence we also know that
|
|
|
|
-- Index - Index_Type'First >= 0
|
[multiple changes]
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
package spec.
* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
while raising PE.
From-SVN: r178245
2011-08-29 16:25:19 +02:00
|
|
|
|
2010-10-25 15:50:29 +02:00
|
|
|
-- The issue is that even though 0 is guaranteed to be a value
|
|
|
|
-- in the type Index_Type'Base, there's no guarantee that the
|
|
|
|
-- difference is a value in that type. To prevent overflow we
|
|
|
|
-- use the wider of Count_Type'Base and Index_Type'Base to
|
|
|
|
-- perform intermediate calculations.
|
|
|
|
|
|
|
|
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
|
|
|
Offset := Count_Type'Base (Index - Index_Type'First);
|
|
|
|
|
|
|
|
else
|
|
|
|
Offset := Count_Type'Base (Index) -
|
|
|
|
Count_Type'Base (Index_Type'First);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- The array index subtype for all container element arrays
|
|
|
|
-- always starts with 1.
|
|
|
|
|
|
|
|
return 1 + Offset;
|
|
|
|
end To_Array_Index;
|
|
|
|
|
|
|
|
---------------
|
|
|
|
-- To_Cursor --
|
|
|
|
---------------
|
|
|
|
|
|
|
|
function To_Cursor
|
|
|
|
(Container : Vector;
|
|
|
|
Index : Extended_Index) return Cursor
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
if Index not in Index_Type'First .. Container.Last then
|
|
|
|
return No_Element;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return Cursor'(Container'Unrestricted_Access, Index);
|
|
|
|
end To_Cursor;
|
|
|
|
|
|
|
|
--------------
|
|
|
|
-- To_Index --
|
|
|
|
--------------
|
|
|
|
|
|
|
|
function To_Index (Position : Cursor) return Extended_Index is
|
|
|
|
begin
|
|
|
|
if Position.Container = null then
|
|
|
|
return No_Index;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Position.Index <= Position.Container.Last then
|
|
|
|
return Position.Index;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return No_Index;
|
|
|
|
end To_Index;
|
|
|
|
|
|
|
|
---------------
|
|
|
|
-- To_Vector --
|
|
|
|
---------------
|
|
|
|
|
|
|
|
function To_Vector (Length : Count_Type) return Vector is
|
|
|
|
Index : Count_Type'Base;
|
|
|
|
Last : Index_Type'Base;
|
|
|
|
|
|
|
|
begin
|
|
|
|
if Length = 0 then
|
|
|
|
return Empty_Vector;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We create a vector object with a capacity that matches the specified
|
|
|
|
-- Length, but we do not allow the vector capacity (the length of the
|
|
|
|
-- internal array) to exceed the number of values in Index_Type'Range
|
|
|
|
-- (otherwise, there would be no way to refer to those components via an
|
|
|
|
-- index). We must therefore check whether the specified Length would
|
|
|
|
-- create a Last index value greater than Index_Type'Last.
|
|
|
|
|
|
|
|
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
|
|
|
-- We perform a two-part test. First we determine whether the
|
|
|
|
-- computed Last value lies in the base range of the type, and then
|
|
|
|
-- determine whether it lies in the range of the index (sub)type.
|
|
|
|
|
|
|
|
-- Last must satisfy this relation:
|
|
|
|
-- First + Length - 1 <= Last
|
|
|
|
-- We regroup terms:
|
|
|
|
-- First - 1 <= Last - Length
|
|
|
|
-- Which can rewrite as:
|
|
|
|
-- No_Index <= Last - Length
|
|
|
|
|
|
|
|
if Index_Type'Base'Last - Index_Type'Base (Length) < No_Index then
|
|
|
|
raise Constraint_Error with "Length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We now know that the computed value of Last is within the base
|
|
|
|
-- range of the type, so it is safe to compute its value:
|
|
|
|
|
|
|
|
Last := No_Index + Index_Type'Base (Length);
|
|
|
|
|
|
|
|
-- Finally we test whether the value is within the range of the
|
|
|
|
-- generic actual index subtype:
|
|
|
|
|
|
|
|
if Last > Index_Type'Last then
|
|
|
|
raise Constraint_Error with "Length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
elsif Index_Type'First <= 0 then
|
[multiple changes]
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
package spec.
* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
while raising PE.
From-SVN: r178245
2011-08-29 16:25:19 +02:00
|
|
|
|
2010-10-25 15:50:29 +02:00
|
|
|
-- Here we can compute Last directly, in the normal way. We know that
|
|
|
|
-- No_Index is less than 0, so there is no danger of overflow when
|
|
|
|
-- adding the (positive) value of Length.
|
|
|
|
|
|
|
|
Index := Count_Type'Base (No_Index) + Length; -- Last
|
|
|
|
|
|
|
|
if Index > Count_Type'Base (Index_Type'Last) then
|
|
|
|
raise Constraint_Error with "Length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We know that the computed value (having type Count_Type) of Last
|
|
|
|
-- is within the range of the generic actual index subtype, so it is
|
|
|
|
-- safe to convert to Index_Type:
|
|
|
|
|
|
|
|
Last := Index_Type'Base (Index);
|
|
|
|
|
|
|
|
else
|
|
|
|
-- Here Index_Type'First (and Index_Type'Last) is positive, so we
|
|
|
|
-- must test the length indirectly (by working backwards from the
|
|
|
|
-- largest possible value of Last), in order to prevent overflow.
|
|
|
|
|
|
|
|
Index := Count_Type'Base (Index_Type'Last) - Length; -- No_Index
|
|
|
|
|
|
|
|
if Index < Count_Type'Base (No_Index) then
|
|
|
|
raise Constraint_Error with "Length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We have determined that the value of Length would not create a
|
|
|
|
-- Last index value outside of the range of Index_Type, so we can now
|
|
|
|
-- safely compute its value.
|
|
|
|
|
|
|
|
Last := Index_Type'Base (Count_Type'Base (No_Index) + Length);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return V : Vector (Capacity => Length) do
|
|
|
|
V.Last := Last;
|
|
|
|
end return;
|
|
|
|
end To_Vector;
|
|
|
|
|
|
|
|
function To_Vector
|
|
|
|
(New_Item : Element_Type;
|
|
|
|
Length : Count_Type) return Vector
|
|
|
|
is
|
|
|
|
Index : Count_Type'Base;
|
|
|
|
Last : Index_Type'Base;
|
|
|
|
|
|
|
|
begin
|
|
|
|
if Length = 0 then
|
|
|
|
return Empty_Vector;
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We create a vector object with a capacity that matches the specified
|
|
|
|
-- Length, but we do not allow the vector capacity (the length of the
|
|
|
|
-- internal array) to exceed the number of values in Index_Type'Range
|
|
|
|
-- (otherwise, there would be no way to refer to those components via an
|
|
|
|
-- index). We must therefore check whether the specified Length would
|
|
|
|
-- create a Last index value greater than Index_Type'Last.
|
|
|
|
|
|
|
|
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
[multiple changes]
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
package spec.
* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
while raising PE.
From-SVN: r178245
2011-08-29 16:25:19 +02:00
|
|
|
|
2010-10-25 15:50:29 +02:00
|
|
|
-- We perform a two-part test. First we determine whether the
|
|
|
|
-- computed Last value lies in the base range of the type, and then
|
|
|
|
-- determine whether it lies in the range of the index (sub)type.
|
|
|
|
|
|
|
|
-- Last must satisfy this relation:
|
|
|
|
-- First + Length - 1 <= Last
|
|
|
|
-- We regroup terms:
|
|
|
|
-- First - 1 <= Last - Length
|
|
|
|
-- Which can rewrite as:
|
|
|
|
-- No_Index <= Last - Length
|
|
|
|
|
|
|
|
if Index_Type'Base'Last - Index_Type'Base (Length) < No_Index then
|
|
|
|
raise Constraint_Error with "Length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We now know that the computed value of Last is within the base
|
|
|
|
-- range of the type, so it is safe to compute its value:
|
|
|
|
|
|
|
|
Last := No_Index + Index_Type'Base (Length);
|
|
|
|
|
|
|
|
-- Finally we test whether the value is within the range of the
|
|
|
|
-- generic actual index subtype:
|
|
|
|
|
|
|
|
if Last > Index_Type'Last then
|
|
|
|
raise Constraint_Error with "Length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
elsif Index_Type'First <= 0 then
|
[multiple changes]
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
package spec.
* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
while raising PE.
From-SVN: r178245
2011-08-29 16:25:19 +02:00
|
|
|
|
2010-10-25 15:50:29 +02:00
|
|
|
-- Here we can compute Last directly, in the normal way. We know that
|
|
|
|
-- No_Index is less than 0, so there is no danger of overflow when
|
|
|
|
-- adding the (positive) value of Length.
|
|
|
|
|
|
|
|
Index := Count_Type'Base (No_Index) + Length; -- same value as V.Last
|
|
|
|
|
|
|
|
if Index > Count_Type'Base (Index_Type'Last) then
|
|
|
|
raise Constraint_Error with "Length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We know that the computed value (having type Count_Type) of Last
|
|
|
|
-- is within the range of the generic actual index subtype, so it is
|
|
|
|
-- safe to convert to Index_Type:
|
|
|
|
|
|
|
|
Last := Index_Type'Base (Index);
|
|
|
|
|
|
|
|
else
|
|
|
|
-- Here Index_Type'First (and Index_Type'Last) is positive, so we
|
|
|
|
-- must test the length indirectly (by working backwards from the
|
|
|
|
-- largest possible value of Last), in order to prevent overflow.
|
|
|
|
|
|
|
|
Index := Count_Type'Base (Index_Type'Last) - Length; -- No_Index
|
|
|
|
|
|
|
|
if Index < Count_Type'Base (No_Index) then
|
|
|
|
raise Constraint_Error with "Length is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
-- We have determined that the value of Length would not create a
|
|
|
|
-- Last index value outside of the range of Index_Type, so we can now
|
|
|
|
-- safely compute its value.
|
|
|
|
|
|
|
|
Last := Index_Type'Base (Count_Type'Base (No_Index) + Length);
|
|
|
|
end if;
|
|
|
|
|
|
|
|
return V : Vector (Capacity => Length) do
|
|
|
|
V.Elements := (others => New_Item);
|
|
|
|
V.Last := Last;
|
|
|
|
end return;
|
|
|
|
end To_Vector;
|
|
|
|
|
|
|
|
--------------------
|
|
|
|
-- Update_Element --
|
|
|
|
--------------------
|
|
|
|
|
|
|
|
procedure Update_Element
|
|
|
|
(Container : in out Vector;
|
|
|
|
Index : Index_Type;
|
|
|
|
Process : not null access procedure (Element : in out Element_Type))
|
|
|
|
is
|
|
|
|
B : Natural renames Container.Busy;
|
|
|
|
L : Natural renames Container.Lock;
|
|
|
|
|
|
|
|
begin
|
|
|
|
if Index > Container.Last then
|
|
|
|
raise Constraint_Error with "Index is out of range";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
B := B + 1;
|
|
|
|
L := L + 1;
|
|
|
|
|
|
|
|
begin
|
|
|
|
Process (Container.Elements (To_Array_Index (Index)));
|
|
|
|
exception
|
|
|
|
when others =>
|
|
|
|
L := L - 1;
|
|
|
|
B := B - 1;
|
|
|
|
raise;
|
|
|
|
end;
|
|
|
|
|
|
|
|
L := L - 1;
|
|
|
|
B := B - 1;
|
|
|
|
end Update_Element;
|
|
|
|
|
|
|
|
procedure Update_Element
|
|
|
|
(Container : in out Vector;
|
|
|
|
Position : Cursor;
|
|
|
|
Process : not null access procedure (Element : in out Element_Type))
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
if Position.Container = null then
|
|
|
|
raise Constraint_Error with "Position cursor has no element";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
if Position.Container /= Container'Unrestricted_Access then
|
|
|
|
raise Program_Error with "Position cursor denotes wrong container";
|
|
|
|
end if;
|
|
|
|
|
|
|
|
Update_Element (Container, Position.Index, Process);
|
|
|
|
end Update_Element;
|
|
|
|
|
|
|
|
-----------
|
|
|
|
-- Write --
|
|
|
|
-----------
|
|
|
|
|
|
|
|
procedure Write
|
|
|
|
(Stream : not null access Root_Stream_Type'Class;
|
|
|
|
Container : Vector)
|
|
|
|
is
|
|
|
|
N : Count_Type;
|
|
|
|
|
|
|
|
begin
|
|
|
|
N := Container.Length;
|
|
|
|
Count_Type'Base'Write (Stream, N);
|
|
|
|
|
|
|
|
for J in 1 .. N loop
|
|
|
|
Element_Type'Write (Stream, Container.Elements (J));
|
|
|
|
end loop;
|
|
|
|
end Write;
|
|
|
|
|
|
|
|
procedure Write
|
|
|
|
(Stream : not null access Root_Stream_Type'Class;
|
|
|
|
Position : Cursor)
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
raise Program_Error with "attempt to stream vector cursor";
|
|
|
|
end Write;
|
|
|
|
|
2011-08-29 16:19:32 +02:00
|
|
|
procedure Write
|
|
|
|
(Stream : not null access Root_Stream_Type'Class;
|
|
|
|
Item : Reference_Type)
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
raise Program_Error with "attempt to stream reference";
|
|
|
|
end Write;
|
|
|
|
|
|
|
|
procedure Write
|
|
|
|
(Stream : not null access Root_Stream_Type'Class;
|
|
|
|
Item : Constant_Reference_Type)
|
|
|
|
is
|
|
|
|
begin
|
|
|
|
raise Program_Error with "attempt to stream reference";
|
|
|
|
end Write;
|
|
|
|
|
2010-10-25 15:50:29 +02:00
|
|
|
end Ada.Containers.Bounded_Vectors;
|