+2010-10-22 Thomas Quinot <quinot@adacore.com>
+
+ * exp_ch5.adb, sem_ch5.adb, sinfo.ads, snames.ads-tmpl, par-ch5.adb:
+ Minor reformatting.
+
+2010-10-22 Geert Bosch <bosch@adacore.com>
+
+ * stand.ads: Fix typo in comment.
+
+2010-10-22 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch6.adb: Enable in-out parameter for functions.
+
+2010-10-22 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch4.adb (Analyze_Quantified_Expression): Handle properly loop
+ iterators that are transformed into container iterators after analysis.
+ * exp_ch4.adb (Expand_N_Quantified_Expression): Handle properly both
+ iterator forms before rewriting as a loop.
+
+2010-10-22 Brett Porter <porter@adacore.com>
+
+ * a-locale.adb, a-locale.ads, locales.c: New files.
+ * Makefile.rtl: Add a-locale
+ * gcc-interface/Makefile.in: Add locales.c
+
2010-10-22 Robert Dewar <dewar@adacore.com>
* sem_util.ads, sem_util.adb, sem_aux.ads, sem_aux.adb
a-llitio$(objext) \
a-lliwti$(objext) \
a-llizti$(objext) \
+ a-locale$(objext) \
a-ncelfu$(objext) \
a-ngcefu$(objext) \
a-ngcoty$(objext) \
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . L O C A L E S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2010, Free Software Foundation, Inc. --
+-- --
+-- 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/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System; use System;
+
+package body Ada.Locales is
+
+ type Lower_4 is array (1 .. 4) of Character range 'a' .. 'z';
+ type Upper_4 is array (1 .. 4) of Character range 'A' .. 'Z';
+
+ --------------
+ -- Language --
+ --------------
+
+ function Language return Language_Code is
+ procedure C_Get_Language_Code (P : Address);
+ pragma Import (C, C_Get_Language_Code);
+ F : Lower_4;
+ begin
+ C_Get_Language_Code (F (1)'Address);
+ return Language_Code (F (1 .. 3));
+ end Language;
+
+ -------------
+ -- Country --
+ -------------
+
+ function Country return Country_Code is
+ procedure C_Get_Country_Code (P : Address);
+ pragma Import (C, C_Get_Country_Code);
+ F : Upper_4;
+ begin
+ C_Get_Country_Code (F (1)'Address);
+ return Country_Code (F (1 .. 2));
+ end Country;
+
+end Ada.Locales;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . L O C A L E S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2010, Free Software Foundation, Inc. --
+-- --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification, provided that if you redistribute a --
+-- modified version, any changes that you have made are clearly indicated. --
+-- --
+------------------------------------------------------------------------------
+
+package Ada.Locales is
+ pragma Preelaborate (Locales);
+ pragma Remote_Types (Locales);
+
+ type Language_Code is array (1 .. 3) of Character range 'a' .. 'z';
+ type Country_Code is array (1 .. 2) of Character range 'A' .. 'Z';
+
+ Language_Unknown : constant Language_Code := "und";
+ Country_Unknown : constant Country_Code := "ZZ";
+
+ function Language return Language_Code;
+ function Country return Country_Code;
+
+end Ada.Locales;
procedure Expand_N_Quantified_Expression (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
- Iterator : constant Node_Id := Loop_Parameter_Specification (N);
Cond : constant Node_Id := Condition (N);
- Actions : List_Id;
- Decl : Node_Id;
- Test : Node_Id;
- Tnn : Entity_Id;
+ Actions : List_Id;
+ Decl : Node_Id;
+ I_Scheme : Node_Id;
+ Test : Node_Id;
+ Tnn : Entity_Id;
-- We expand:
-- end if;
-- end loop;
+ -- In both cases, the iteration may be over a container, in which
+ -- case it is given by an iterator specification, not a loop.
+
begin
Actions := New_List;
Tnn := Make_Temporary (Loc, 'T');
Make_Exit_Statement (Loc)));
end if;
+ if Present (Loop_Parameter_Specification (N)) then
+ I_Scheme :=
+ Make_Iteration_Scheme (Loc,
+ Loop_Parameter_Specification =>
+ Loop_Parameter_Specification (N));
+ else
+ I_Scheme :=
+ Make_Iteration_Scheme (Loc,
+ Iterator_Specification => Iterator_Specification (N));
+ end if;
+
Append_To (Actions,
Make_Loop_Statement (Loc,
- Iteration_Scheme =>
- Make_Iteration_Scheme (Loc,
- Loop_Parameter_Specification => Iterator),
+ Iteration_Scheme => I_Scheme,
Statements => New_List (Test),
End_Label => Empty));
+ -- The components of the scheme have already been analyzed, and the
+ -- loop index declaration has been processed.
+
+ Set_Analyzed (Iteration_Scheme (Last (Actions)));
+
Rewrite (N,
Make_Expression_With_Actions (Loc,
Expression => New_Occurrence_Of (Tnn, Loc),
-- might be filled with components from child types).
procedure Expand_Iterator_Loop (N : Node_Id);
- -- Expand loops over arrays and containers that use the form "for X of C"
- -- with an optional subtype mark, and "for Y in C".
+ -- Expand loop over arrays and containers that uses the form "for X of C"
+ -- with an optional subtype mark, or "for Y in C".
function Make_Tag_Ctrl_Assignment (N : Node_Id) return List_Id;
-- Generate the necessary code for controlled and tagged assignment, that
if Of_Present (I_Spec) then
Cursor := Make_Temporary (Loc, 'C');
- -- For Elem of Arr loop ..
+ -- for Elem of Arr loop ...
declare
Decl : constant Node_Id :=
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Id,
- Subtype_Mark =>
+ Subtype_Mark =>
New_Occurrence_Of (Component_Type (Typ), Loc),
- Name => Make_Indexed_Component (Loc,
- Prefix => New_Occurrence_Of (Container, Loc),
- Expressions =>
- New_List (New_Occurrence_Of (Cursor, Loc))));
+ Name =>
+ Make_Indexed_Component (Loc,
+ Prefix =>
+ New_Occurrence_Of (Container, Loc),
+ Expressions =>
+ New_List (New_Occurrence_Of (Cursor, Loc))));
begin
Stats := Statements (N);
Prepend (Decl, Stats);
- New_Loop := Make_Loop_Statement (Loc,
- Iteration_Scheme =>
- Make_Iteration_Scheme (Loc,
- Loop_Parameter_Specification =>
- Make_Loop_Parameter_Specification (Loc,
- Defining_Identifier => Cursor,
- Discrete_Subtype_Definition =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Container, Loc),
- Attribute_Name => Name_Range),
- Reverse_Present => Reverse_Present (I_Spec))),
- Statements => Stats,
- End_Label => Empty);
+ New_Loop :=
+ Make_Loop_Statement (Loc,
+ Iteration_Scheme =>
+ Make_Iteration_Scheme (Loc,
+ Loop_Parameter_Specification =>
+ Make_Loop_Parameter_Specification (Loc,
+ Defining_Identifier => Cursor,
+ Discrete_Subtype_Definition =>
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Occurrence_Of (Container, Loc),
+ Attribute_Name => Name_Range),
+ Reverse_Present => Reverse_Present (I_Spec))),
+ Statements => Stats,
+ End_Label => Empty);
end;
else
- -- For Index in Array loop
- --
- -- The cursor (index into the array) is the source Id.
+ -- for Index in Array loop ...
+
+ -- The cursor (index into the array) is the source Id
Cursor := Id;
- New_Loop := Make_Loop_Statement (Loc,
- Iteration_Scheme =>
- Make_Iteration_Scheme (Loc,
- Loop_Parameter_Specification =>
- Make_Loop_Parameter_Specification (Loc,
- Defining_Identifier => Cursor,
- Discrete_Subtype_Definition =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Container, Loc),
- Attribute_Name => Name_Range),
- Reverse_Present => Reverse_Present (I_Spec))),
- Statements => Statements (N),
- End_Label => Empty);
+ New_Loop :=
+ Make_Loop_Statement (Loc,
+ Iteration_Scheme =>
+ Make_Iteration_Scheme (Loc,
+ Loop_Parameter_Specification =>
+ Make_Loop_Parameter_Specification (Loc,
+ Defining_Identifier => Cursor,
+ Discrete_Subtype_Definition =>
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Occurrence_Of (Container, Loc),
+ Attribute_Name => Name_Range),
+ Reverse_Present => Reverse_Present (I_Spec))),
+ Statements => Statements (N),
+ End_Label => Empty);
end if;
else
- -- Iterators over containers. In both cases these require a
- -- cursor of the proper type.
+ -- Iterators over containers. In both cases these require a cursor of
+ -- the proper type.
-- Cursor : P.Cursor_Type := Container.First;
-- while Cursor /= P.No_Element loop
- -- -- for the "of" form, the element name renames
- -- -- the element denoted by the cursor.
-
-- Obj : P.Element_Type renames Element (Cursor);
+ -- -- For the "of" form, the element name renames the element
+ -- -- designated by the cursor.
+
-- Statements;
-- P.Next (Cursor);
-- end loop;
-- C : Cursor_Type := Container.First;
- Cursor_Decl := Make_Object_Declaration (Loc,
- Defining_Identifier => Cursor,
- Object_Definition =>
- Make_Selected_Component (Loc,
- Prefix => New_Occurrence_Of (Pack, Loc),
- Selector_Name =>
- Make_Identifier (Loc, Name_Cursor)),
- Expression =>
- Make_Selected_Component (Loc,
- Prefix => New_Occurrence_Of (Container, Loc),
- Selector_Name => Make_Identifier (Loc, Name_Init)));
+ Cursor_Decl :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Cursor,
+ Object_Definition =>
+ Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (Pack, Loc),
+ Selector_Name => Make_Identifier (Loc, Name_Cursor)),
+ Expression =>
+ Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (Container, Loc),
+ Selector_Name => Make_Identifier (Loc, Name_Init)));
Insert_Action (N, Cursor_Decl);
-- while C /= No_Element loop
Cond := Make_Op_Ne (Loc,
- Left_Opnd => New_Occurrence_Of (Cursor, Loc),
- Right_Opnd => Make_Selected_Component (Loc,
- Prefix => New_Occurrence_Of (Pack, Loc),
- Selector_Name => Make_Identifier (Loc,
- Chars => Name_No_Element)));
+ Left_Opnd => New_Occurrence_Of (Cursor, Loc),
+ Right_Opnd => Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (Pack, Loc),
+ Selector_Name =>
+ Make_Identifier (Loc, Chars => Name_No_Element)));
if Of_Present (I_Spec) then
Renaming_Decl :=
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Id,
- Subtype_Mark => New_Occurrence_Of (Element_Type, Loc),
- Name => Make_Indexed_Component (Loc,
- Prefix =>
- Make_Selected_Component (Loc,
- Prefix => New_Occurrence_Of (Pack, Loc),
- Selector_Name =>
- Make_Identifier (Loc, Chars => Name_Element)),
- Expressions =>
- New_List (New_Occurrence_Of (Cursor, Loc))));
+ Subtype_Mark =>
+ New_Occurrence_Of (Element_Type, Loc),
+ Name =>
+ Make_Indexed_Component (Loc,
+ Prefix =>
+ Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (Pack, Loc),
+ Selector_Name =>
+ Make_Identifier (Loc, Chars => Name_Element)),
+ Expressions =>
+ New_List (New_Occurrence_Of (Cursor, Loc))));
Prepend (Renaming_Decl, Stats);
end if;
- -- For both iterator forms, add call to Next to advance cursor.
+ -- For both iterator forms, add call to step operation (Next or
+ -- Previous) to advance cursor.
Append_To (Stats,
Make_Procedure_Call_Statement (Loc,
- Name => Make_Selected_Component (Loc,
- Prefix => New_Occurrence_Of (Pack, Loc),
- Selector_Name => Make_Identifier (Loc, Name_Step)),
+ Name =>
+ Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (Pack, Loc),
+ Selector_Name => Make_Identifier (Loc, Name_Step)),
Parameter_Associations =>
New_List (New_Occurrence_Of (Cursor, Loc))));
New_Loop := Make_Loop_Statement (Loc,
Iteration_Scheme =>
- Make_Iteration_Scheme (Loc,
- Condition => Cond),
- Statements => Stats,
- End_Label => Empty);
+ Make_Iteration_Scheme (Loc, Condition => Cond),
+ Statements => Stats,
+ End_Label => Empty);
end;
end if;
-- Set_Analyzed (I_Spec);
+ -- Why is this commented out???
+
Rewrite (N, New_Loop);
Analyze (N);
end Expand_Iterator_Loop;
LIBGNAT_SRCS = adadecode.c adadecode.h adaint.c adaint.h \
argv.c cio.c cstreams.c errno.c exit.c cal.c ctrl_c.c env.c env.h \
arit64.c raise.h raise.c sysdep.c aux-io.c init.c initialize.c \
- seh_init.c final.c tracebak.c tb-alvms.c tb-alvxw.c tb-gcc.c \
- expect.c mkdir.c socket.c gsocket.h targext.c $(EXTRA_LIBGNAT_SRCS)
+ locales.c seh_init.c final.c tracebak.c tb-alvms.c tb-alvxw.c \
+ tb-gcc.c expect.c mkdir.c socket.c gsocket.h targext.c $(EXTRA_LIBGNAT_SRCS)
LIBGNAT_OBJS = adadecode.o adaint.o argv.o cio.o cstreams.o ctrl_c.o \
errno.o exit.o env.o raise.o sysdep.o aux-io.o init.o initialize.o \
- seh_init.o cal.o arit64.o final.o tracebak.o expect.o mkdir.o \
- socket.o targext.o $(EXTRA_LIBGNAT_OBJS)
+ locales.o seh_init.o cal.o arit64.o final.o tracebak.o expect.o \
+ mkdir.o socket.o targext.o $(EXTRA_LIBGNAT_OBJS)
# NOTE ??? - when the -I option for compiling Ada code is made to work,
# the library installation will change and there will be a
expect.o : expect.c
final.o : final.c
link.o : link.c
+locales.o : locales.c
mkdir.o : mkdir.c
socket.o : socket.c gsocket.h
sysdep.o : sysdep.c
--- /dev/null
+/****************************************************************************
+ * *
+ * GNAT COMPILER COMPONENTS *
+ * *
+ * L O C A L E S *
+ * *
+ * C Implementation File *
+ * *
+ * Copyright (C) 2010, Free Software Foundation, Inc. *
+ * *
+ * 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/>. *
+ * *
+ * GNAT was originally developed by the GNAT team at New York University. *
+ * Extensive contributions were provided by Ada Core Technologies Inc. *
+ * *
+ ****************************************************************************/
+
+/* This file provides OS-dependent support for the Ada.Locales package. */
+
+typedef char char4 [4];
+
+/*
+ c_get_language_code needs to fill in the Alpha-3 encoding of the
+ language code (3 lowercase letters). That shoud be "und" if the
+ language is unknown. [see Ada.Locales]
+*/
+void c_get_language_code (char4 p) {
+ char *r = "und";
+ for (; *r != '\0'; p++, r++)
+ *p = *r;
+}
+
+/*
+ c_get_country_code needs to fill in the Alpha-2 encoding of the
+ country code (2 uppercase letters). That shoud be "ZZ" if the
+ country is unknown. [see Ada.Locales]
+*/
+void c_get_country_code (char4 p) {
+ char *r = "ZZ";
+ for (; *r != '\0'; p++, r++)
+ *p = *r;
+}
Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr);
Spec := P_Loop_Parameter_Specification;
if Nkind (Spec) = N_Loop_Parameter_Specification then
- Set_Loop_Parameter_Specification
- (Iter_Scheme_Node, Spec);
+ Set_Loop_Parameter_Specification (Iter_Scheme_Node, Spec);
else
Set_Iterator_Specification (Iter_Scheme_Node, Spec);
end if;
Save_Scan_State (Scan_State);
ID_Node := P_Defining_Identifier (C_In);
- -- If the next token is OF it indicates the Ada2012 iterator. If the
- -- next token is a colon, the iterator includes a subtype indication
- -- for the bound variable of the iteration. Otherwise we parse the
- -- construct as a loop parameter specification. Note that the form:
+ -- If the next token is OF, it indicates an Ada 2012 iterator. If the
+ -- next token is a colon, this is also an Ada 2012 iterator, including a
+ -- subtype indication for the loop parameter. Otherwise we parse the
+ -- construct as a loop parameter specification. Note that the form
-- "for A in B" is ambiguous, and must be resolved semantically: if B
-- is a discrete subtype this is a loop specification, but if it is an
-- expression it is an iterator specification. Ambiguity is resolved
-- during analysis of the loop parameter specification.
- if Token = Tok_Of
- or else Token = Tok_Colon
- then
+ if Token = Tok_Of or else Token = Tok_Colon then
return P_Iterator_Specification (ID_Node);
end if;
if Token = Tok_Of then
Set_Of_Present (Node1);
Scan; -- past OF
+
elsif Token = Tok_In then
Scan; -- past IN
+
else
return Error;
end if;
Set_Etype (Ent, Standard_Void_Type);
Set_Parent (Ent, N);
- Iterator :=
- Make_Iteration_Scheme (Loc,
- Loop_Parameter_Specification => Loop_Parameter_Specification (N));
+ if Present (Loop_Parameter_Specification (N)) then
+ Iterator :=
+ Make_Iteration_Scheme (Loc,
+ Loop_Parameter_Specification =>
+ Loop_Parameter_Specification (N));
+ else
+ Iterator :=
+ Make_Iteration_Scheme (Loc,
+ Iterator_Specification =>
+ Iterator_Specification (N));
+ end if;
Push_Scope (Ent);
+ Set_Parent (Iterator, N);
Analyze_Iteration_Scheme (Iterator);
+
+ -- The loop specification may have been converted into an
+ -- iterator specification during its analysis. Update the
+ -- quantified node accordingly.
+
+ if Present (Iterator_Specification (Iterator)) then
+ Set_Iterator_Specification
+ (N, Iterator_Specification (Iterator));
+ Set_Loop_Parameter_Specification (N, Empty);
+ end if;
+
Analyze (Condition (N));
End_Scope;
and then not Is_Type (Entity (DS)))
then
- -- this is an iterator specification. Rewrite as
- -- such and analyze.
+ -- This is an iterator specification. Rewrite as such
+ -- and analyze.
declare
I_Spec : constant Node_Id :=
- Make_Iterator_Specification (Sloc (LP),
- Defining_Identifier => Relocate_Node (Id),
- Name => Relocate_Node (DS),
- Subtype_Indication => Empty,
- Reverse_Present => Reverse_Present (LP));
+ Make_Iterator_Specification (Sloc (LP),
+ Defining_Identifier =>
+ Relocate_Node (Id),
+ Name =>
+ Relocate_Node (DS),
+ Subtype_Indication =>
+ Empty,
+ Reverse_Present =>
+ Reverse_Present (LP));
begin
Set_Iterator_Specification (N, I_Spec);
return;
end if;
- -- The subtype indication may denote the completion
- -- of an incomplete type declaration.
+ -- The subtype indication may denote the completion of an
+ -- incomplete type declaration.
if Is_Entity_Name (DS)
and then Present (Entity (DS))
Make_Index (DS, LP);
- Set_Ekind (Id, E_Loop_Parameter);
- Set_Etype (Id, Etype (DS));
+ Set_Ekind (Id, E_Loop_Parameter);
+ Set_Etype (Id, Etype (DS));
-- Treat a range as an implicit reference to the type, to
-- inhibit spurious warnings.
-- instances, because in practice they tend to be dubious
-- in these cases.
- if Nkind (DS) = N_Range
- and then Comes_From_Source (N)
- then
+ if Nkind (DS) = N_Range and then Comes_From_Source (N) then
declare
L : constant Node_Id := Low_Bound (DS);
H : constant Node_Id := High_Bound (DS);
(L, H, Assume_Valid => True) = GT
then
-- Suppress the warning if inside a generic
- -- template or instance, since in practice
- -- they tend to be dubious in these cases since
- -- they can result from intended parametrization.
+ -- template or instance, since in practice they
+ -- tend to be dubious in these cases since they can
+ -- result from intended parametrization.
if not Inside_A_Generic
and then not In_Instance
-- In either case, suppress warnings in the body of
-- the loop, since it is likely that these warnings
-- will be inappropriate if the loop never actually
- -- executes, which is unlikely.
+ -- executes, which is likely.
Set_Suppress_Loop_Warnings (Parent (N));
-- The other case for a warning is a reverse loop
- -- where the upper bound is the integer literal
- -- zero or one, and the lower bound can be positive.
+ -- where the upper bound is the integer literal zero
+ -- or one, and the lower bound can be positive.
-- For example, we have
-- for J in reverse N .. 1 loop
- -- In practice, this is very likely to be a case
- -- of reversing the bounds incorrectly in the range.
+ -- In practice, this is very likely to be a case of
+ -- reversing the bounds incorrectly in the range.
elsif Reverse_Present (LP)
and then Nkind (Original_Node (H)) =
end if;
else
- -- Iteration over a container.
+ -- Iteration over a container
Set_Ekind (Def_Id, E_Loop_Parameter);
if Of_Present (N) then
- -- Find the Element_Type in the package instance that defines
- -- the container type.
+ -- Find the Element_Type in the package instance that defines the
+ -- container type.
Ent := First_Entity (Scope (Typ));
while Present (Ent) loop
else
- -- Find the Cursor type in similar fashion.
+ -- Find the Cursor type in similar fashion
Ent := First_Entity (Scope (Typ));
while Present (Ent) loop
if Ekind (Scope (Formal_Id)) = E_Function
or else Ekind (Scope (Formal_Id)) = E_Generic_Function
then
- Error_Msg_N ("functions can only have IN parameters", Spec);
- Set_Ekind (Formal_Id, E_In_Parameter);
+
+ if Ada_Version >= Ada_2012 then
+ if In_Present (Spec) then
+ Set_Ekind (Formal_Id, E_In_Out_Parameter);
+ else
+ Set_Ekind (Formal_Id, E_Out_Parameter);
+ end if;
+
+ else
+ Error_Msg_N ("functions can only have IN parameters", Spec);
+ Set_Ekind (Formal_Id, E_In_Parameter);
+ end if;
elsif In_Present (Spec) then
Set_Ekind (Formal_Id, E_In_Out_Parameter);
-- Initialize_Scalars and Normalize_Scalars.
-- Of_Present (Flag16)
- -- Present in N_Iterastor_Specification nodes, to mark the Ada2012 iterator
+ -- Present in N_Iterator_Specification nodes, to mark the Ada 2012 iterator
-- form over arrays and containers.
-- Original_Discriminant (Node2-Sem)
---------------------------------
-- QUANTIFIED_EXPRESSION ::=
- -- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
- -- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
+ -- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE
+ -- | for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
--
-- QUANTIFIER ::= all | some
+ -- At most one of (Iterator_Specification, Loop_Parameter_Specification)
+ -- is present at a time, in which case the other one is empty.
+
-- N_Quantified_Expression
-- Sloc points to FOR
- -- Iterator_Specification (Node2) (set to Empty if not Present)
+ -- Iterator_Specification (Node2)
-- Loop_Parameter_Specification (Node4)
-- Condition (Node1)
-- All_Present (Flag15)
--------------------------
-- ITERATION_SCHEME ::=
- -- while CONDITION | for LOOP_PARAMETER_SPECIFICATION |
- -- for ITERATOR_SPECIFICATION
+ -- while CONDITION
+ -- | for LOOP_PARAMETER_SPECIFICATION
+ -- | for ITERATOR_SPECIFICATION
- -- Only one of (Iterator_Specification, Loop_Parameter_Specification)
- -- is present at a time, the other one is empty.
+ -- At most one of (Iterator_Specification, Loop_Parameter_Specification)
+ -- is present at a time, in which case the other one is empty. Both are
+ -- empty in the case of a WHILE loop.
-- Gigi restriction: This expander ensures that the type of the
-- Condition field is always Standard.Boolean, even if the type
-- Sloc points to WHILE or FOR
-- Condition (Node1) (set to Empty if FOR case)
-- Condition_Actions (List3-Sem)
- -- Iterator_Specification (Node2) (set to Empty if not Present)
+ -- Iterator_Specification (Node2) (set to Empty if WHILE case)
-- Loop_Parameter_Specification (Node4) (set to Empty if WHILE case)
---------------------------------------
-- ITERATOR_SPECIFICATION ::=
-- DEFINING_IDENTIFIER in [reverse] NAME
- -- DEFINING_IDENTIFIER [: SUBTYPE_INDICATION] of [reverse] NAME
+ -- | DEFINING_IDENTIFIER [: SUBTYPE_INDICATION] of [reverse] NAME
-- N_Iterator_Specification
-- Sloc points to defining identifier
Name_Unaligned_Valid : constant Name_Id := N + $;
- -- Names used to implement iterators over predefined containers.
+ -- Names used to implement iterators over predefined containers
Name_Cursor : constant Name_Id := N + $;
Name_Element : constant Name_Id := N + $;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- 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- --
Universal_Real : Entity_Id;
-- Entity for universal real type. The bounds of this type correspond to
- -- to the largest supported real type (i.e. Long_Long_Real). It is the
+ -- to the largest supported real type (i.e. Long_Long_Float). It is the
-- type used for runtime calculations in type universal real. Note that
- -- this type is always IEEE format, even if Long_Long_Real is Vax_Float
+ -- this type is always IEEE format, even if Long_Long_Float is Vax_Float
-- (and in that case the bounds don't correspond exactly).
Universal_Fixed : Entity_Id;
projects / platform / upstream / gcc.git / commitdiff