git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

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

From-SVN: r165812
This commit is contained in:
Arnaud Charlet 2010-10-22 12:00:18 +02:00
parent 57d62f0cb7
commit c56a9ba447
15 changed files with 385 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
gcc/ada/ChangeLog
View File

@ -1,3 +1,29 @@
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

1
gcc/ada/Makefile.rtl
View File

@ -158,6 +158,7 @@ GNATRTL_NONTASKING_OBJS= \
a-llitio$(objext) \
a-lliwti$(objext) \
a-llizti$(objext) \
a-locale$(objext) \
a-ncelfu$(objext) \
a-ngcefu$(objext) \
a-ngcoty$(objext) \

65
gcc/ada/a-locale.adb Normal file
View File

@ -0,0 +1,65 @@
------------------------------------------------------------------------------
-- --
-- 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;

31
gcc/ada/a-locale.ads Normal file
View File

@ -0,0 +1,31 @@
------------------------------------------------------------------------------
-- --
-- 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;

33
gcc/ada/exp_ch4.adb
View File

@ -7428,13 +7428,13 @@ package body Exp_Ch4 is
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:
@ -7460,6 +7460,9 @@ package body Exp_Ch4 is
-- 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');
@ -7496,14 +7499,28 @@ package body Exp_Ch4 is
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),

161
gcc/ada/exp_ch5.adb
View File

@ -104,8 +104,8 @@ package body Exp_Ch5 is
-- 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
@ -2773,71 +2773,77 @@ package body Exp_Ch5 is
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;
@ -2879,28 +2885,28 @@ package body Exp_Ch5 is
-- 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
@ -2909,39 +2915,44 @@ package body Exp_Ch5 is
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;

9
gcc/ada/gcc-interface/Makefile.in
View File

@ -2215,13 +2215,13 @@ endif
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
@ -2757,6 +2757,7 @@ exit.o : adaint.h exit.c
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

56
gcc/ada/locales.c Normal file
View File

@ -0,0 +1,56 @@
/****************************************************************************
* *
* 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;
}

17
gcc/ada/par-ch5.adb
View File

@ -1571,8 +1571,7 @@ package body Ch5 is
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;
@ -1701,18 +1700,16 @@ package body Ch5 is
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;
@ -1765,8 +1762,10 @@ package body Ch5 is
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;

26
gcc/ada/sem_ch4.adb
View File

@ -3198,12 +3198,32 @@ package body Sem_Ch4 is
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;

54
gcc/ada/sem_ch5.adb
View File

@ -1809,16 +1809,20 @@ package body Sem_Ch5 is
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);
@ -1833,8 +1837,8 @@ package body Sem_Ch5 is
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))
@ -1854,8 +1858,8 @@ package body Sem_Ch5 is
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.
@ -1879,9 +1883,7 @@ package body Sem_Ch5 is
-- 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);
@ -1893,9 +1895,9 @@ package body Sem_Ch5 is
(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
@ -1937,20 +1939,20 @@ package body Sem_Ch5 is
-- 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)) =
@ -2002,13 +2004,13 @@ package body Sem_Ch5 is
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
@ -2022,7 +2024,7 @@ package body Sem_Ch5 is
else
-- Find the Cursor type in similar fashion.
-- Find the Cursor type in similar fashion
Ent := First_Entity (Scope (Typ));
while Present (Ent) loop

14
gcc/ada/sem_ch6.adb
View File

@ -9365,8 +9365,18 @@ package body Sem_Ch6 is
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);

25
gcc/ada/sinfo.ads
View File

@ -1545,7 +1545,7 @@ package Sinfo is
-- 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)
@ -3826,14 +3826,17 @@ package Sinfo is
---------------------------------
-- 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)
@ -4169,11 +4172,13 @@ package Sinfo is
--------------------------
-- 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
@ -4183,7 +4188,7 @@ package Sinfo is
-- 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)
---------------------------------------
@ -4205,7 +4210,7 @@ package Sinfo is
-- 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

2
gcc/ada/snames.ads-tmpl
View File

@ -1198,7 +1198,7 @@ package Snames is
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 + $;

6
gcc/ada/stand.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -413,9 +413,9 @@ package Stand is
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;