mirror of git://gcc.gnu.org/git/gcc.git
[multiple changes]
2011-08-31 Robert Dewar <dewar@adacore.com> * exp_ch5.adb, exp_ch7.ads, sem_ch5.adb, put_scos.adb, s-rannum.adb, a-rbtgbo.adb, exp_intr.adb, a-cbdlli.adb, a-cbdlli.ads: Minor reformatting. 2011-08-31 Hristian Kirtchev <kirtchev@adacore.com> * exp_util.adb (Find_Protection_Type): Do not look for fields _object if the corresponding type is malformed due to restriction violations. 2011-08-31 Robert Dewar <dewar@adacore.com> * s-ransee.ads, s-ransee.adb: Minor reformatting. 2011-08-31 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch4.adb (Expand_N_Allocator): Correct faulty condition which would cause the generation of Set_Finalize_Address if the target is a VM and the designated type is not derived from [Limited_]Controlled. 2011-08-31 Arnaud Charlet <charlet@adacore.com> * comperr.adb, comperr.ads, gnat1drv.adb (Delete_SCIL_Files): New subprogram. (Compiler_Abort, Gnat1drv): Call Delete_SCIL_Files in codepeer mode in case of a compilation error. 2011-08-31 Hristian Kirtchev <kirtchev@adacore.com> * init.c (__gnat_error_handler): Standardize the stack overflow or erroneous memory access message. * seh_init.c (__gnat_SEH_error_handler): Standardize the stack overflow or erroneous memory access message. From-SVN: r178368
This commit is contained in:
Arnaud Charlet
parent
11bc76df47
commit
e0c321665e
|
|
@ -1,3 +1,38 @@
|
|||
2011-08-31 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* exp_ch5.adb, exp_ch7.ads, sem_ch5.adb, put_scos.adb, s-rannum.adb,
|
||||
a-rbtgbo.adb, exp_intr.adb, a-cbdlli.adb, a-cbdlli.ads: Minor
|
||||
reformatting.
|
||||
|
||||
2011-08-31 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* exp_util.adb (Find_Protection_Type): Do not look for fields _object
|
||||
if the corresponding type is malformed due to restriction violations.
|
||||
|
||||
2011-08-31 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* s-ransee.ads, s-ransee.adb: Minor reformatting.
|
||||
|
||||
2011-08-31 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* exp_ch4.adb (Expand_N_Allocator): Correct faulty condition which
|
||||
would cause the generation of Set_Finalize_Address if the target is a
|
||||
VM and the designated type is not derived from [Limited_]Controlled.
|
||||
|
||||
2011-08-31 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* comperr.adb, comperr.ads, gnat1drv.adb (Delete_SCIL_Files): New
|
||||
subprogram.
|
||||
(Compiler_Abort, Gnat1drv): Call Delete_SCIL_Files in codepeer mode in
|
||||
case of a compilation error.
|
||||
|
||||
2011-08-31 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* init.c (__gnat_error_handler): Standardize the stack overflow or
|
||||
erroneous memory access message.
|
||||
* seh_init.c (__gnat_SEH_error_handler): Standardize the stack overflow
|
||||
or erroneous memory access message.
|
||||
|
||||
2011-08-31 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch4.adb: Minor reformatting.
|
||||
|
|
|
|||
|
|
@ -1046,6 +1046,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
|
|||
Process (Cursor'(Container'Unrestricted_Access, Node));
|
||||
Node := Container.Nodes (Node).Next;
|
||||
end loop;
|
||||
|
||||
exception
|
||||
when others =>
|
||||
B := B - 1;
|
||||
|
|
@ -1055,8 +1056,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
|
|||
B := B - 1;
|
||||
end Iterate;
|
||||
|
||||
function Iterate (Container : List)
|
||||
return List_Iterator_Interfaces.Reversible_Iterator'class
|
||||
function Iterate
|
||||
(Container : List)
|
||||
return List_Iterator_Interfaces.Reversible_Iterator'class
|
||||
is
|
||||
begin
|
||||
if Container.Length = 0 then
|
||||
|
|
@ -1066,8 +1068,10 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
|
|||
end if;
|
||||
end Iterate;
|
||||
|
||||
function Iterate (Container : List; Start : Cursor)
|
||||
return List_Iterator_Interfaces.Reversible_Iterator'class
|
||||
function Iterate
|
||||
(Container : List;
|
||||
Start : Cursor)
|
||||
return List_Iterator_Interfaces.Reversible_Iterator'class
|
||||
is
|
||||
It : constant Iterator := (Container'Unrestricted_Access, Start.Node);
|
||||
begin
|
||||
|
|
|
|||
|
|
@ -44,8 +44,7 @@ package Ada.Containers.Bounded_Doubly_Linked_Lists is
|
|||
pragma Pure;
|
||||
pragma Remote_Types;
|
||||
|
||||
type List (Capacity : Count_Type) is tagged private
|
||||
with
|
||||
type List (Capacity : Count_Type) is tagged private with
|
||||
Constant_Indexing => Constant_Reference,
|
||||
Variable_Indexing => Reference,
|
||||
Default_Iterator => Iterate,
|
||||
|
|
@ -59,6 +58,7 @@ package Ada.Containers.Bounded_Doubly_Linked_Lists is
|
|||
Empty_List : constant List;
|
||||
|
||||
No_Element : constant Cursor;
|
||||
|
||||
function Has_Element (Position : Cursor) return Boolean;
|
||||
|
||||
package List_Iterator_Interfaces is new
|
||||
|
|
@ -140,10 +140,13 @@ package Ada.Containers.Bounded_Doubly_Linked_Lists is
|
|||
|
||||
procedure Reverse_Elements (Container : in out List);
|
||||
|
||||
function Iterate (Container : List)
|
||||
function Iterate
|
||||
(Container : List)
|
||||
return List_Iterator_Interfaces.Reversible_Iterator'class;
|
||||
|
||||
function Iterate (Container : List; Start : Cursor)
|
||||
function Iterate
|
||||
(Container : List;
|
||||
Start : Cursor)
|
||||
return List_Iterator_Interfaces.Reversible_Iterator'class;
|
||||
|
||||
procedure Swap
|
||||
|
|
|
|||
|
|
@ -63,8 +63,11 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
|
|||
Tree.Last := 0;
|
||||
Tree.Root := 0;
|
||||
Tree.Length := 0;
|
||||
|
||||
-- Why are the following commented out with no explanation ???
|
||||
-- Tree.Busy
|
||||
-- Tree.Lock
|
||||
|
||||
Tree.Free := -1;
|
||||
end Clear_Tree;
|
||||
|
||||
|
|
@ -76,7 +79,6 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
|
|||
(Tree : in out Tree_Type'Class;
|
||||
Node : Count_Type)
|
||||
is
|
||||
|
||||
-- CLR p. 274
|
||||
|
||||
X : Count_Type;
|
||||
|
|
@ -143,7 +145,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
|
|||
end if;
|
||||
|
||||
if (Left (N (W)) = 0 or else Color (N (Left (N (W)))) = Black)
|
||||
and then
|
||||
and then
|
||||
(Right (N (W)) = 0 or else Color (N (Right (N (W)))) = Black)
|
||||
then
|
||||
Set_Color (N (W), Red);
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2011, 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- --
|
||||
|
|
@ -27,20 +27,23 @@
|
|||
-- error is detected. Calls to these routines cause termination of the
|
||||
-- current compilation with appropriate error output.
|
||||
|
||||
with Atree; use Atree;
|
||||
with Debug; use Debug;
|
||||
with Errout; use Errout;
|
||||
with Gnatvsn; use Gnatvsn;
|
||||
with Namet; use Namet;
|
||||
with Opt; use Opt;
|
||||
with Osint; use Osint;
|
||||
with Output; use Output;
|
||||
with Sinput; use Sinput;
|
||||
with Sprint; use Sprint;
|
||||
with Sdefault; use Sdefault;
|
||||
with Targparm; use Targparm;
|
||||
with Treepr; use Treepr;
|
||||
with Types; use Types;
|
||||
with Atree; use Atree;
|
||||
with Debug; use Debug;
|
||||
with Errout; use Errout;
|
||||
with Gnatvsn; use Gnatvsn;
|
||||
with Lib; use Lib;
|
||||
with Namet; use Namet;
|
||||
with Opt; use Opt;
|
||||
with Osint; use Osint;
|
||||
with Output; use Output;
|
||||
with Sinfo; use Sinfo;
|
||||
with Sinput; use Sinput;
|
||||
with Sprint; use Sprint;
|
||||
with Sdefault; use Sdefault;
|
||||
with System.OS_Lib; use System.OS_Lib;
|
||||
with Targparm; use Targparm;
|
||||
with Treepr; use Treepr;
|
||||
with Types; use Types;
|
||||
|
||||
with Ada.Exceptions; use Ada.Exceptions;
|
||||
|
||||
|
|
@ -144,6 +147,10 @@ package body Comperr is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
if CodePeer_Mode then
|
||||
Delete_SCIL_Files;
|
||||
end if;
|
||||
|
||||
-- If any errors have already occurred, then we guess that the abort
|
||||
-- may well be caused by previous errors, and we don't make too much
|
||||
-- fuss about it, since we want to let programmer fix the errors first.
|
||||
|
|
@ -422,9 +429,40 @@ package body Comperr is
|
|||
Source_Dump;
|
||||
raise Unrecoverable_Error;
|
||||
end if;
|
||||
|
||||
end Compiler_Abort;
|
||||
|
||||
-----------------------
|
||||
-- Delete_SCIL_Files --
|
||||
-----------------------
|
||||
|
||||
procedure Delete_SCIL_Files is
|
||||
Main : Node_Id;
|
||||
Success : Boolean;
|
||||
pragma Unreferenced (Success);
|
||||
begin
|
||||
-- If parsing was not successful, no Main_Unit is available, so return
|
||||
-- immediately.
|
||||
|
||||
if Main_Source_File = No_Source_File then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Retrieve unit name, and remove old versions of SCIL/<unit>.scil and
|
||||
-- SCIL/<unit>__body.scil
|
||||
|
||||
Main := Unit (Cunit (Main_Unit));
|
||||
|
||||
if Nkind (Main) = N_Subprogram_Body then
|
||||
Get_Name_String (Chars (Defining_Unit_Name (Specification (Main))));
|
||||
else
|
||||
Get_Name_String (Chars (Defining_Unit_Name (Main)));
|
||||
end if;
|
||||
|
||||
Delete_File ("SCIL/" & Name_Buffer (1 .. Name_Len) & ".scil", Success);
|
||||
Delete_File
|
||||
("SCIL/" & Name_Buffer (1 .. Name_Len) & "__body.scil", Success);
|
||||
end Delete_SCIL_Files;
|
||||
|
||||
-----------------
|
||||
-- Repeat_Char --
|
||||
-----------------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2011, 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- --
|
||||
|
|
@ -50,6 +50,9 @@ package Comperr is
|
|||
-- end exception (with possible message stored in TSD.Current_Excep,
|
||||
-- and negative (an unused value) for a GCC abort.
|
||||
|
||||
procedure Delete_SCIL_Files;
|
||||
-- Delete SCIL files associated with the main unit
|
||||
|
||||
------------------------------
|
||||
-- Use of gnat_bug.box File --
|
||||
------------------------------
|
||||
|
|
|
|||
|
|
@ -3949,13 +3949,13 @@ package body Exp_Ch4 is
|
|||
-- Types derived from [Limited_]Controlled are the only
|
||||
-- ones considered since they have fields Prev and Next.
|
||||
|
||||
if VM_Target /= No_VM
|
||||
and then Is_Controlled (T)
|
||||
then
|
||||
Insert_Action (N,
|
||||
Make_Attach_Call
|
||||
(Obj_Ref => New_Copy_Tree (Init_Arg1),
|
||||
Ptr_Typ => PtrT));
|
||||
if VM_Target /= No_VM then
|
||||
if Is_Controlled (T) then
|
||||
Insert_Action (N,
|
||||
Make_Attach_Call
|
||||
(Obj_Ref => New_Copy_Tree (Init_Arg1),
|
||||
Ptr_Typ => PtrT));
|
||||
end if;
|
||||
|
||||
-- Default case, generate:
|
||||
|
||||
|
|
|
|||
|
|
@ -3249,7 +3249,7 @@ package body Exp_Ch5 is
|
|||
Subtype_Mark => New_Occurrence_Of (Iter_Type, Loc),
|
||||
Name => Relocate_Node (Name (I_Spec)));
|
||||
|
||||
-- Create declaration for cursor.
|
||||
-- Create declaration for cursor
|
||||
|
||||
Decl2 :=
|
||||
Make_Object_Declaration (Loc,
|
||||
|
|
|
|||
|
|
@ -41,33 +41,34 @@ package Exp_Ch7 is
|
|||
-- that take care of finalization management at run-time.
|
||||
|
||||
-- Support of exceptions from user finalization procedures
|
||||
--
|
||||
|
||||
-- There is a specific mechanism to handle these exceptions, continue
|
||||
-- finalization and then raise PE.
|
||||
-- This mechanism is used by this package but also by exp_intr for
|
||||
-- Ada.Unchecked_Deallocation.
|
||||
-- finalization and then raise PE. This mechanism is used by this package
|
||||
-- but also by exp_intr for Ada.Unchecked_Deallocation.
|
||||
|
||||
-- There are 3 subprograms to use this mechanism, and the type
|
||||
-- Finalization_Exception_Data carries internal data between these
|
||||
-- subprograms:
|
||||
--
|
||||
-- 1. Build_Object_Declaration: create the variables for the next two
|
||||
-- subprograms.
|
||||
-- 2. Build_Exception_Handler: create the exception handler for a call to
|
||||
-- a user finalization procedure.
|
||||
-- 3. Build_Raise_Stmt: create the code to potentially raise a PE exception
|
||||
-- if am exception was raise in a user finalization procedure.
|
||||
-- 1. Build_Object_Declaration: create the variables for the next two
|
||||
-- subprograms.
|
||||
-- 2. Build_Exception_Handler: create the exception handler for a call
|
||||
-- to a user finalization procedure.
|
||||
-- 3. Build_Raise_Stmt: create code to potentially raise a PE exception
|
||||
-- if an exception was raise in a user finalization procedure.
|
||||
|
||||
type Finalization_Exception_Data is record
|
||||
Loc : Source_Ptr;
|
||||
Loc : Source_Ptr;
|
||||
-- Sloc for the added nodes
|
||||
|
||||
Abort_Id : Entity_Id;
|
||||
Abort_Id : Entity_Id;
|
||||
-- Boolean variable set to true if the finalization was triggered by
|
||||
-- an abort.
|
||||
|
||||
E_Id : Entity_Id;
|
||||
E_Id : Entity_Id;
|
||||
-- Variable containing the exception occurrence raised by user code
|
||||
|
||||
Raised_Id : Entity_Id;
|
||||
Raised_Id : Entity_Id;
|
||||
-- Boolean variable set to true if an exception was raised in user code
|
||||
end record;
|
||||
|
||||
|
|
|
|||
|
|
@ -964,19 +964,15 @@ package body Exp_Intr is
|
|||
Make_Block_Statement (Loc,
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => New_List (
|
||||
Make_Final_Call (
|
||||
Obj_Ref => Deref,
|
||||
Typ => Desig_T)),
|
||||
Statements => New_List (
|
||||
Make_Final_Call (Obj_Ref => Deref, Typ => Desig_T)),
|
||||
Exception_Handlers => New_List (
|
||||
Build_Exception_Handler (Finalizer_Data)))));
|
||||
|
||||
-- For .NET/JVM, detach the object from the containing finalization
|
||||
-- collection before finalizing it.
|
||||
|
||||
if VM_Target /= No_VM
|
||||
and then Is_Controlled (Desig_T)
|
||||
then
|
||||
if VM_Target /= No_VM and then Is_Controlled (Desig_T) then
|
||||
Prepend_To (Final_Code,
|
||||
Make_Detach_Call (New_Copy_Tree (Arg)));
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -2313,6 +2313,15 @@ package body Exp_Util is
|
|||
Typ := Corresponding_Record_Type (Typ);
|
||||
end if;
|
||||
|
||||
-- Since restriction violations are not considered serious errors, the
|
||||
-- expander remains active, but may leave the corresponding record type
|
||||
-- malformed. In such cases, component _object is not available so do
|
||||
-- not look for it.
|
||||
|
||||
if not Analyzed (Typ) then
|
||||
return Empty;
|
||||
end if;
|
||||
|
||||
Comp := First_Component (Typ);
|
||||
while Present (Comp) loop
|
||||
if Chars (Comp) = Name_uObject then
|
||||
|
|
|
|||
|
|
@ -842,6 +842,10 @@ begin
|
|||
Tree_Gen;
|
||||
end if;
|
||||
|
||||
if CodePeer_Mode then
|
||||
Comperr.Delete_SCIL_Files;
|
||||
end if;
|
||||
|
||||
Errout.Finalize (Last_Call => True);
|
||||
Exit_Program (E_Errors);
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -358,7 +358,7 @@ __gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
|
|||
((volatile char *)
|
||||
((long) si->si_addr & - getpagesize ()))[getpagesize ()];
|
||||
exception = &storage_error;
|
||||
msg = "stack overflow (or erroneous memory access)";
|
||||
msg = "stack overflow or erroneous memory access";
|
||||
}
|
||||
break;
|
||||
|
||||
|
|
@ -644,7 +644,7 @@ __gnat_error_handler (int sig, siginfo_t *si ATTRIBUTE_UNUSED, void *ucontext)
|
|||
that this is quite acceptable, since a "real" SIGSEGV can only
|
||||
occur as the result of an erroneous program. */
|
||||
exception = &storage_error;
|
||||
msg = "stack overflow (or erroneous memory access)";
|
||||
msg = "stack overflow or erroneous memory access";
|
||||
break;
|
||||
|
||||
case SIGBUS:
|
||||
|
|
@ -824,7 +824,7 @@ __gnat_error_handler (int sig, siginfo_t *reason, void *uc ATTRIBUTE_UNUSED)
|
|||
the stack into a guard page, not an attempt to
|
||||
write to .text or something. */
|
||||
exception = &storage_error;
|
||||
msg = "SIGSEGV: (stack overflow or erroneous memory access)";
|
||||
msg = "SIGSEGV: stack overflow or erroneous memory access";
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -1022,7 +1022,7 @@ __gnat_error_handler (int sig, siginfo_t *si, void *ucontext ATTRIBUTE_UNUSED)
|
|||
((volatile char *)
|
||||
((long) si->si_addr & - getpagesize ()))[getpagesize ()];
|
||||
exception = &storage_error;
|
||||
msg = "stack overflow (or erroneous memory access)";
|
||||
msg = "stack overflow or erroneous memory access";
|
||||
}
|
||||
break;
|
||||
|
||||
|
|
@ -1421,7 +1421,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
|
|||
else
|
||||
{
|
||||
exception = &storage_error;
|
||||
msg = "stack overflow (or erroneous memory access)";
|
||||
msg = "stack overflow or erroneous memory access";
|
||||
}
|
||||
__gnat_adjust_context_for_raise (SS$_ACCVIO, (void *)mechargs);
|
||||
break;
|
||||
|
|
|
|||
|
|
@ -82,6 +82,7 @@ procedure Put_SCOs is
|
|||
|
||||
procedure Write_SCO_Initiate (SU : SCO_Unit_Index) is
|
||||
SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (SU);
|
||||
|
||||
begin
|
||||
if Current_SCO_Unit /= SU then
|
||||
Write_Info_Initiate ('C');
|
||||
|
|
@ -126,7 +127,7 @@ begin
|
|||
T : SCO_Table_Entry renames SCO_Table.Table (Start);
|
||||
Continuation : Boolean;
|
||||
|
||||
Ctr : Nat;
|
||||
Ctr : Nat;
|
||||
-- Counter for statement entries
|
||||
|
||||
begin
|
||||
|
|
|
|||
|
|
@ -87,6 +87,7 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Unchecked_Conversion;
|
||||
|
||||
with System.Random_Seed;
|
||||
|
||||
with Interfaces; use Interfaces;
|
||||
|
|
@ -480,7 +481,7 @@ package body System.Random_Numbers is
|
|||
|
||||
procedure Reset (Gen : Generator) is
|
||||
X : constant Unsigned_32 :=
|
||||
Unsigned_32'Mod (Unsigned_64 (Random_Seed.Get_Seed) * 64);
|
||||
Unsigned_32'Mod (Unsigned_64 (Random_Seed.Get_Seed) * 64);
|
||||
-- Why * 64 ???
|
||||
|
||||
begin
|
||||
|
|
|
|||
|
|
@ -29,6 +29,8 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- Version used on all systems except Ravenscar where Calendar is unavailable
|
||||
|
||||
with Ada.Calendar; use Ada.Calendar;
|
||||
|
||||
package body System.Random_Seed is
|
||||
|
|
|
|||
|
|
@ -31,11 +31,13 @@
|
|||
|
||||
-- This package provide a seed for pseudo-random number generation using
|
||||
-- the clock.
|
||||
|
||||
-- There are two separate implementations of this package:
|
||||
-- o one based on Ada.Calendar
|
||||
-- o one based on Ada.Real_Time
|
||||
|
||||
-- This is required because Ada.Calendar cannot be used on ravenscar, but
|
||||
-- Ada.Real_Time drags the tasking runtime on regular platforms.
|
||||
-- Ada.Real_Time drags in the whole tasking runtime on regular platforms.
|
||||
|
||||
package System.Random_Seed is
|
||||
|
||||
|
|
|
|||
|
|
@ -99,7 +99,7 @@ __gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
|
|||
{
|
||||
/* otherwise it is a stack overflow */
|
||||
exception = &storage_error;
|
||||
msg = "stack overflow (or erroneous memory access)";
|
||||
msg = "stack overflow or erroneous memory access";
|
||||
}
|
||||
break;
|
||||
|
||||
|
|
|
|||
|
|
@ -2244,9 +2244,8 @@ package body Sem_Ch5 is
|
|||
Typ : Entity_Id;
|
||||
|
||||
begin
|
||||
-- In semantics mode, introduce loop variable so that
|
||||
-- loop body can be properly analyzed. Otherwise this
|
||||
-- is one after expansion.
|
||||
-- In semantics mode, introduce loop variable so that loop body can be
|
||||
-- properly analyzed. Otherwise this is one after expansion.
|
||||
|
||||
if Operating_Mode = Check_Semantics then
|
||||
Enter_Name (Def_Id);
|
||||
|
|
@ -2335,7 +2334,7 @@ package body Sem_Ch5 is
|
|||
Error_Msg_N
|
||||
("to iterate over the elements of an array, use OF", N);
|
||||
|
||||
-- Prevent cascaded errors.
|
||||
-- Prevent cascaded errors
|
||||
|
||||
Set_Ekind (Def_Id, E_Constant);
|
||||
Set_Etype (Def_Id, Etype (First_Index (Typ)));
|
||||
|
|
@ -2496,11 +2495,11 @@ package body Sem_Ch5 is
|
|||
or else not Expander_Active
|
||||
then
|
||||
if Present (Iter)
|
||||
and then Present (Iterator_Specification (Iter))
|
||||
and then Present (Iterator_Specification (Iter))
|
||||
then
|
||||
declare
|
||||
Id : constant Entity_Id :=
|
||||
Defining_Identifier (Iterator_Specification (Iter));
|
||||
Defining_Identifier (Iterator_Specification (Iter));
|
||||
begin
|
||||
if Scope (Id) /= Current_Scope then
|
||||
Enter_Name (Id);
|
||||
|
|
|
|||
Loading…
Reference in New Issue