+2016-04-19 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_attr.adb (Resolve_Attribute, case 'Access): Freeze
+ overloadable entity if originally overloaded.
+
+2016-04-19 Arnaud Charlet <charlet@adacore.com>
+
+ * exp_aggr.adb, exp_ch3.adb, exp_ch7.adb, exp_ch9.adb, exp_code.adb,
+ exp_fixd.adb, namet.adb, osint.adb, osint.ads, par-ch2.adb,
+ sem_ch10.adb, sem_ch12.adb, sem_disp.adb, sem_elab.adb, sem_elim.adb
+ sem_util.adb, styleg.adb, styleg.ads, stylesw.ads: Minor code
+ clean up.
+
2016-04-19 Arnaud Charlet <charlet@adacore.com>
* sem_util.adb (Copy_Node_With_Replacement):
-- This avoids running away with attempts to convert huge aggregates,
-- which hit memory limits in the backend.
- function Component_Count (T : Entity_Id) return Int;
+ function Component_Count (T : Entity_Id) return Nat;
-- The limit is applied to the total number of components that the
-- aggregate will have, which is the number of static expressions
-- that will appear in the flattened array. This requires a recursive
-- Component_Count --
---------------------
- function Component_Count (T : Entity_Id) return Int is
- Res : Int := 0;
+ function Component_Count (T : Entity_Id) return Nat is
+ Res : Nat := 0;
Comp : Entity_Id;
begin
Hi : constant Node_Id :=
Type_High_Bound (Etype (First_Index (T)));
- Siz : constant Int := Component_Count (Component_Type (T));
+ Siz : constant Nat := Component_Count (Component_Type (T));
begin
if not Compile_Time_Known_Value (Lo)
First_Comp : Node_Id;
Discriminant : Entity_Id;
Decl : Node_Id;
- Num_Disc : Int := 0;
- Num_Gird : Int := 0;
+ Num_Disc : Nat := 0;
+ Num_Gird : Nat := 0;
procedure Prepend_Stored_Values (T : Entity_Id);
-- Scan the list of stored discriminants of the type, and add
Decls : constant List_Id := New_List;
Discr_Map : constant Elist_Id := New_Elmt_List;
Loc : constant Source_Ptr := Sloc (Rec_Ent);
- Counter : Int := 0;
+ Counter : Nat := 0;
Proc_Id : Entity_Id;
Rec_Type : Entity_Id;
Set_Tag : Entity_Id := Empty;
-- Jump_Alts
Counter_Id : Entity_Id := Empty;
- Counter_Val : Int := 0;
+ Counter_Val : Nat := 0;
-- Name and value of the state counter
Decls : List_Id := No_List;
Spec : Node_Id;
Typ : Entity_Id;
- Old_Counter_Val : Int;
+ Old_Counter_Val : Nat;
-- This variable is used to determine whether a nested package or
-- instance contains at least one controlled object.
-- families of 128K should be reasonable in all cases, and is a documented
-- implementation restriction.
- Entry_Family_Bound : constant Int := 2**16;
+ Entry_Family_Bound : constant Pos := 2**16;
-----------------------
-- Local Subprograms --
Entry_Count_Expr : constant Node_Id :=
Build_Entry_Count_Expression
(Prot_Typ, Cdecls, Loc);
- Num_Attach_Handler : Int := 0;
+ Num_Attach_Handler : Nat := 0;
Protection_Subtype : Node_Id;
Ritem : Node_Id;
Delay_Val : Entity_Id;
Delay_Index : Entity_Id;
Delay_Min : Entity_Id;
- Delay_Num : Int := 1;
+ Delay_Num : Pos := 1;
Delay_Alt_List : List_Id := New_List;
Delay_List : constant List_Id := New_List;
D : Entity_Id;
Guard_Open : Entity_Id;
End_Lab : Node_Id;
- Index : Int := 1;
+ Index : Pos := 1;
Lab : Node_Id;
Num_Alts : Int;
Num_Accept : Nat := 0;
-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2015, 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- --
-- and not modified by Clobber_Get_Next. Empty if clobber string was in
-- error (resulting in no clobber arguments being returned).
- Clobber_Ptr : Nat;
+ Clobber_Ptr : Pos;
-- Pointer to current character of string. Initialized to 1 by the call
-- to Clobber_Setup, and then updated by Clobber_Get_Next.
(N : Node_Id;
X, Y, Z : Node_Id) return Node_Id
is
- Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
- Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
+ Y_Size : constant Nat := UI_To_Int (Esize (Etype (Y)));
+ Z_Size : constant Nat := UI_To_Int (Esize (Etype (Z)));
Expr : Node_Id;
begin
-- If denominator fits in 64 bits, we can build the operations directly
-- without causing any intermediate overflow, so that's what we do.
- if Int'Max (Y_Size, Z_Size) <= 32 then
+ if Nat'Max (Y_Size, Z_Size) <= 32 then
return
Build_Divide (N, X, Build_Multiply (N, Y, Z));
is
Loc : constant Source_Ptr := Sloc (N);
- X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
- Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
- Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
+ X_Size : constant Nat := UI_To_Int (Esize (Etype (X)));
+ Y_Size : constant Nat := UI_To_Int (Esize (Etype (Y)));
+ Z_Size : constant Nat := UI_To_Int (Esize (Etype (Z)));
- QR_Siz : Int;
+ QR_Siz : Nat;
QR_Typ : Entity_Id;
Nnn : Entity_Id;
begin
-- Find type that will allow computation of numerator
- QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
+ QR_Siz := Nat'Max (X_Size, 2 * Nat'Max (Y_Size, Z_Size));
if QR_Siz <= 16 then
QR_Typ := Standard_Integer_16;
QR_Typ := Standard_Integer_64;
-- For more than 64, bits, we use the 64-bit integer defined in
- -- Interfaces, so that it can be handled by the runtime routine
+ -- Interfaces, so that it can be handled by the runtime routine.
else
QR_Typ := RTE (RE_Integer_64);
(N : Node_Id;
X, Y, Z : Node_Id) return Node_Id
is
- X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
- Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
+ X_Size : constant Nat := UI_To_Int (Esize (Etype (X)));
+ Y_Size : constant Nat := UI_To_Int (Esize (Etype (Y)));
Expr : Node_Id;
begin
-- If numerator fits in 64 bits, we can build the operations directly
-- without causing any intermediate overflow, so that's what we do.
- if Int'Max (X_Size, Y_Size) <= 32 then
+ if Nat'Max (X_Size, Y_Size) <= 32 then
return
Build_Divide (N, Build_Multiply (N, X, Y), Z);
is
Loc : constant Source_Ptr := Sloc (N);
- X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
- Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
- Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
+ X_Size : constant Nat := UI_To_Int (Esize (Etype (X)));
+ Y_Size : constant Nat := UI_To_Int (Esize (Etype (Y)));
+ Z_Size : constant Nat := UI_To_Int (Esize (Etype (Z)));
- QR_Siz : Int;
+ QR_Siz : Nat;
QR_Typ : Entity_Id;
Nnn : Entity_Id;
begin
-- Find type that will allow computation of numerator
- QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
+ QR_Siz := Nat'Max (X_Size, 2 * Nat'Max (Y_Size, Z_Size));
if QR_Siz <= 16 then
QR_Typ := Standard_Integer_16;
QR_Typ := Standard_Integer_64;
-- For more than 64, bits, we use the 64-bit integer defined in
- -- Interfaces, so that it can be handled by the runtime routine
+ -- Interfaces, so that it can be handled by the runtime routine.
else
QR_Typ := RTE (RE_Integer_64);
-- N'th entry is the number of chains of length N, except last entry,
-- which is the number of chains of length F'Last or more.
- Max_Chain_Length : Int := 0;
+ Max_Chain_Length : Nat := 0;
-- Maximum length of all chains
- Probes : Int := 0;
+ Probes : Nat := 0;
-- Used to compute average number of probes
- Nsyms : Int := 0;
+ Nsyms : Nat := 0;
-- Number of symbols in table
Verbosity : constant Int range 1 .. 3 := 1;
else
declare
- C : Int;
+ C : Nat;
N : Name_Id;
S : Int;
EOL : constant Character := ASCII.LF;
-- End of line character
- Number_File_Names : Int := 0;
+ Number_File_Names : Nat := 0;
-- Number of file names found on command line and placed in File_Names
Look_In_Primary_Directory_For_Current_Main : Boolean := False;
-- Number_Of_Files --
---------------------
- function Number_Of_Files return Int is
+ function Number_Of_Files return Nat is
begin
return Number_File_Names;
end Number_Of_Files;
-- lower case form, so that two environment variable names compare equal if
-- they refer to the same environment variable.
- function Number_Of_Files return Int;
+ function Number_Of_Files return Nat;
-- Gives the total number of filenames found on the command line
No_Index : constant := -1;
Import_Check_Required : Boolean := False;
-- Set True if check of pragma IMPORT is required
- Arg_Count : Int := 0;
+ Arg_Count : Nat := 0;
-- Number of argument associations processed
Identifier_Seen : Boolean := False;
Get_Next_Interp (Index, It);
end loop;
- -- If Prefix is a subprogram name, this reference freezes:
+ -- If Prefix is a subprogram name, this reference freezes,
+ -- but not if within spec expression mode
+
+ if not In_Spec_Expression then
+ Freeze_Before (N, Entity (P));
+ end if;
-- If it is a type, there is nothing to resolve.
-- If it is an object, complete its resolution.
elsif Is_Overloadable (Entity (P)) then
- -- Avoid insertion of freeze actions in spec expression mode
-
if not In_Spec_Expression then
Freeze_Before (N, Entity (P));
end if;
Par_Unit : constant Entity_Id := Current_Scope;
Lib_Spec : Node_Id := Library_Unit (Lib_Unit);
- Num_Scopes : Int := 0;
+ Num_Scopes : Nat := 0;
Use_Clauses : array (1 .. Scope_Stack.Last) of Node_Id;
Enclosing_Child : Entity_Id := Empty;
Svg : constant Suppress_Record := Scope_Suppress;
-- name of the formal.
Is_Named_Assoc : Boolean;
- Num_Matched : Int := 0;
- Num_Actuals : Int := 0;
+ Num_Matched : Nat := 0;
+ Num_Actuals : Nat := 0;
Others_Present : Boolean := False;
Others_Choice : Node_Id := Empty;
-- to provide a clean environment for analysis of the inlined body will
-- eliminate any previously set SPARK_Mode.
- Scope_Stack_Depth : constant Int :=
+ Scope_Stack_Depth : constant Pos :=
Scope_Stack.Last - Scope_Stack.First + 1;
Use_Clauses : array (1 .. Scope_Stack_Depth) of Node_Id;
Inner_Scopes : array (1 .. Scope_Stack_Depth) of Entity_Id;
Curr_Scope : Entity_Id := Empty;
List : Elist_Id;
- Num_Inner : Int := 0;
- Num_Scopes : Int := 0;
- N_Instances : Int := 0;
+ Num_Inner : Nat := 0;
+ Num_Scopes : Nat := 0;
+ N_Instances : Nat := 0;
Removed : Boolean := False;
S : Entity_Id;
Vis : Boolean;
I2 : Node_Id;
T2 : Entity_Id;
- function Formal_Dimensions return Int;
+ function Formal_Dimensions return Nat;
-- Count number of dimensions in array type formal
-----------------------
-- Formal_Dimensions --
-----------------------
- function Formal_Dimensions return Int is
- Num : Int := 0;
+ function Formal_Dimensions return Nat is
+ Num : Nat := 0;
Index : Node_Id;
begin
procedure Preanalyze_Actuals (N : Node_Id; Inst : Entity_Id := Empty) is
Assoc : Node_Id;
Act : Node_Id;
- Errs : constant Int := Serious_Errors_Detected;
+ Errs : constant Nat := Serious_Errors_Detected;
Cur : Entity_Id := Empty;
-- Current homograph of the instance name
-- table, but it would be awfully heavy, and there is no way that we
-- could reasonably exceed this value.
- N : Int := 0;
+ N : Nat := 0;
-- Number of entries in Result
Parent_Op : Entity_Id;
-- then the body of the generic will be in the earlier instance.
declare
- D1 : constant Int := Instantiation_Depth (Sloc (Ent));
- D2 : constant Int := Instantiation_Depth (Sloc (N));
+ D1 : constant Nat := Instantiation_Depth (Sloc (Ent));
+ D2 : constant Nat := Instantiation_Depth (Sloc (N));
begin
if D1 > D2 then
-- --
-- B o d y --
-- --
--- Copyright (C) 1997-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1997-2015, 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- --
--------------------
function Line_Num_Match return Boolean is
- N : Int := 0;
+ N : Nat := 0;
begin
if Idx = 0 then
then
declare
Root1, Root2 : Node_Id;
- Depth1, Depth2 : Int := 0;
+ Depth1, Depth2 : Nat := 0;
begin
Root1 := Prefix (A1);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, 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- --
-- In check max line length mode (-gnatym), the line length must
-- not exceed the permitted maximum value.
- procedure Check_Line_Max_Length (Len : Int) is
+ procedure Check_Line_Max_Length (Len : Nat) is
begin
if Style_Check_Max_Line_Length then
if Len > Style_Max_Line_Length then
-- In check DOS line terminators node (-gnatyd), the line terminator
-- must be a single LF, without a following CR.
- procedure Check_Line_Terminator (Len : Int) is
+ procedure Check_Line_Terminator (Len : Nat) is
S : Source_Ptr;
- L : Int := Len;
+ L : Nat := Len;
-- Length of line (adjusted down for blanks at end of line)
begin
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, 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- --
procedure Check_Left_Paren;
-- Called after scanning out a left parenthesis to check spacing
- procedure Check_Line_Max_Length (Len : Int);
+ procedure Check_Line_Max_Length (Len : Nat);
-- Called with Scan_Ptr pointing to the first line terminator character
-- terminating the current line. Used to check for appropriate line length.
-- The parameter Len is the length of the current line.
- procedure Check_Line_Terminator (Len : Int);
+ procedure Check_Line_Terminator (Len : Nat);
-- Called with Scan_Ptr pointing to the first line terminator terminating
-- the current line, used to check for appropriate line terminator usage.
-- The parameter Len is the length of the current line.
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, 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- --
-- not allowed to enclose entire expressions in tests in parentheses
-- (C style), e.g. if (x = y) then ... is not allowed.
- Style_Max_Line_Length : Int := 0;
+ Style_Max_Line_Length : Nat := 0;
-- Value used to check maximum line length. Gets reset as a result of
-- use of -gnatym or -gnatyMnnn switches. This value is only read if
-- Style_Check_Max_Line_Length is True.
- Style_Max_Nesting_Level : Int := 0;
+ Style_Max_Nesting_Level : Nat := 0;
-- Value used to check maximum nesting level. Gets reset as a result
-- of use of the -gnatyLnnn switch. This value is only read if
-- Style_Check_Max_Nesting_Level is True.