[multiple changes]
2014-07-18 Robert Dewar <dewar@adacore.com> * bcheck.adb (Check_Consistent_Restrictions): Remove obsolete code checking for violation of No_Standard_Allocators_After_Elaboration (main program) * bindgen.adb (Gen_Adainit): Handle No_Standard_Allocators_After_Elaboration (Gen_Output_File_Ada): ditto. * exp_ch4.adb (Expand_N_Allocator): Handle No_Standard_Allocators_After_Elaboration. * Makefile.rtl: Add entry for s-elaall * rtsfind.ads: Add entry for Check_Standard_Allocator. * s-elaall.ads, s-elaall.adb: New files. * sem_ch4.adb (Analyze_Allocator): Handle No_Standard_Allocators_After_Elaboration. 2014-07-18 Robert Dewar <dewar@adacore.com> * lib.adb, lib.ads, lib-writ.adb, lib-writ.ads, ali.adb, ali.ads, lib-load.adb: Remove Lib.Has_Allocator and all uses. Remove AB parameter from ali files and all uses. Remove Allocator_In_Body and all uses. 2014-07-18 Robert Dewar <dewar@adacore.com> * g-expect-vms.adb: Add comment. 2014-07-18 Thomas Quinot <quinot@adacore.com> * par_sco.adb (Is_Logical_Operation): return True for N_If_Expression. 2014-07-18 Ed Schonberg <schonberg@adacore.com> * sem_attr.adb (Resolve_Attribute, case 'Update): Do full analysis and resolution of each choice in the associations within the argument of Update, because they may be variable names. 2014-07-18 Hristian Kirtchev <kirtchev@adacore.com> * exp_attr.adb (Expand_Loop_Entry_Attribute): Insert any condition actions before the generated if statement. 2014-07-18 Hristian Kirtchev <kirtchev@adacore.com> * gnat_ugn.texi Enhance the documentation of switches -gnateA and -gnateV. 2014-07-18 Ed Schonberg <schonberg@adacore.com> * sem_util.adb (Build_Default_Subtype): Add missing condition so that code matches description: use the full view of the base only if the base is private and the subtype is not. From-SVN: r212779
This commit is contained in:
Arnaud Charlet
parent
537b531270
commit
b3b26ace90
|
|
@ -1,3 +1,57 @@
|
|||
2014-07-18 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* bcheck.adb (Check_Consistent_Restrictions):
|
||||
Remove obsolete code checking for violation of
|
||||
No_Standard_Allocators_After_Elaboration (main program)
|
||||
* bindgen.adb (Gen_Adainit): Handle
|
||||
No_Standard_Allocators_After_Elaboration
|
||||
(Gen_Output_File_Ada): ditto.
|
||||
* exp_ch4.adb (Expand_N_Allocator): Handle
|
||||
No_Standard_Allocators_After_Elaboration.
|
||||
* Makefile.rtl: Add entry for s-elaall
|
||||
* rtsfind.ads: Add entry for Check_Standard_Allocator.
|
||||
* s-elaall.ads, s-elaall.adb: New files.
|
||||
* sem_ch4.adb (Analyze_Allocator): Handle
|
||||
No_Standard_Allocators_After_Elaboration.
|
||||
|
||||
2014-07-18 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* lib.adb, lib.ads, lib-writ.adb, lib-writ.ads, ali.adb,
|
||||
ali.ads, lib-load.adb: Remove Lib.Has_Allocator and all uses.
|
||||
Remove AB parameter from ali files and all uses.
|
||||
Remove Allocator_In_Body and all uses.
|
||||
|
||||
2014-07-18 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* g-expect-vms.adb: Add comment.
|
||||
|
||||
2014-07-18 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* par_sco.adb (Is_Logical_Operation): return True for
|
||||
N_If_Expression.
|
||||
|
||||
2014-07-18 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_attr.adb (Resolve_Attribute, case 'Update): Do full
|
||||
analysis and resolution of each choice in the associations within
|
||||
the argument of Update, because they may be variable names.
|
||||
|
||||
2014-07-18 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* exp_attr.adb (Expand_Loop_Entry_Attribute): Insert any condition
|
||||
actions before the generated if statement.
|
||||
|
||||
2014-07-18 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* gnat_ugn.texi Enhance the documentation of
|
||||
switches -gnateA and -gnateV.
|
||||
|
||||
2014-07-18 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_util.adb (Build_Default_Subtype): Add missing condition
|
||||
so that code matches description: use the full view of the base
|
||||
only if the base is private and the subtype is not.
|
||||
|
||||
2014-07-17 Gary Dismukes <dismukes@adacore.com>
|
||||
|
||||
* exp_disp.adb: Minor reformatting.
|
||||
|
|
|
|||
|
|
@ -518,6 +518,7 @@ GNATRTL_NONTASKING_OBJS= \
|
|||
s-direio$(objext) \
|
||||
s-dmotpr$(objext) \
|
||||
s-dsaser$(objext) \
|
||||
s-elaall$(objext) \
|
||||
s-excdeb$(objext) \
|
||||
s-except$(objext) \
|
||||
s-exctab$(objext) \
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2014, 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- --
|
||||
|
|
@ -894,7 +894,6 @@ package body ALI is
|
|||
Sfile => No_File,
|
||||
Task_Dispatching_Policy => ' ',
|
||||
Time_Slice_Value => -1,
|
||||
Allocator_In_Body => False,
|
||||
WC_Encoding => 'b',
|
||||
Unit_Exception_Table => False,
|
||||
Ver => (others => ' '),
|
||||
|
|
@ -977,14 +976,6 @@ package body ALI is
|
|||
|
||||
Skip_Space;
|
||||
|
||||
if Nextc = 'A' then
|
||||
P := P + 1;
|
||||
Checkc ('B');
|
||||
ALIs.Table (Id).Allocator_In_Body := True;
|
||||
end if;
|
||||
|
||||
Skip_Space;
|
||||
|
||||
if Nextc = 'C' then
|
||||
P := P + 1;
|
||||
Checkc ('=');
|
||||
|
|
|
|||
|
|
@ -142,10 +142,6 @@ package ALI is
|
|||
-- line. A value of -1 indicates that no T=xxx parameter was found, or
|
||||
-- no M line was present. Not set if 'M' appears in Ignore_Lines.
|
||||
|
||||
Allocator_In_Body : Boolean;
|
||||
-- Set True if an AB switch appears on the main program line. False
|
||||
-- if no M line, or AB not present, or 'M appears in Ignore_Lines.
|
||||
|
||||
WC_Encoding : Character;
|
||||
-- Wide character encoding if main procedure. Otherwise not relevant.
|
||||
-- Not set if 'M' appears in Ignore_Lines.
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2014, 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- --
|
||||
|
|
@ -923,21 +923,18 @@ package body Bcheck is
|
|||
-- Start of processing for Check_Consistent_Restrictions
|
||||
|
||||
begin
|
||||
-- A special test, if we have a main program, then if it has an
|
||||
-- allocator in the body, this is considered to be a violation of
|
||||
-- the restriction No_Allocators_After_Elaboration. We just mark
|
||||
-- this restriction and then the normal circuit will flag it.
|
||||
-- We used to have a special test here:
|
||||
|
||||
if Bind_Main_Program
|
||||
and then ALIs.Table (ALIs.First).Main_Program /= None
|
||||
and then not No_Main_Subprogram
|
||||
and then ALIs.Table (ALIs.First).Allocator_In_Body
|
||||
then
|
||||
Cumulative_Restrictions.Violated
|
||||
(No_Standard_Allocators_After_Elaboration) := True;
|
||||
ALIs.Table (ALIs.First).Restrictions.Violated
|
||||
(No_Standard_Allocators_After_Elaboration) := True;
|
||||
end if;
|
||||
-- A special test, if we have a main program, then if it has an
|
||||
-- allocator in the body, this is considered to be a violation of
|
||||
-- the restriction No_Allocators_After_Elaboration. We just mark
|
||||
-- this restriction and then the normal circuit will flag it.
|
||||
|
||||
-- But we don't do that any more, because in the final version of Ada
|
||||
-- 2012, it is statically illegal to have an allocator in a library-
|
||||
-- level subprogram, so we don't need this bind time test any more.
|
||||
-- If we have a main program with parameters (which GNAT allows), then
|
||||
-- allocators in that will be caught by the run-time check.
|
||||
|
||||
-- Loop through all restriction violations
|
||||
|
||||
|
|
|
|||
|
|
@ -739,8 +739,8 @@ package body Bindgen is
|
|||
if Dispatching_Domains_Used then
|
||||
WBI (" procedure Freeze_Dispatching_Domains;");
|
||||
WBI (" pragma Import");
|
||||
WBI (" (Ada, Freeze_Dispatching_Domains, " &
|
||||
"""__gnat_freeze_dispatching_domains"");");
|
||||
WBI (" (Ada, Freeze_Dispatching_Domains, "
|
||||
& """__gnat_freeze_dispatching_domains"");");
|
||||
end if;
|
||||
|
||||
WBI (" begin");
|
||||
|
|
@ -749,6 +749,18 @@ package body Bindgen is
|
|||
WBI (" end if;");
|
||||
WBI (" Is_Elaborated := True;");
|
||||
|
||||
-- Call System.Elaboration_Allocators.Mark_Start_Of_Elaboration if
|
||||
-- restriction No_Standard_Allocators_After_Elaboration is active.
|
||||
|
||||
if Cumulative_Restrictions.Set
|
||||
(No_Standard_Allocators_After_Elaboration)
|
||||
then
|
||||
WBI (" System.Elaboration_Allocators."
|
||||
& "Mark_Start_Of_Elaboration;");
|
||||
end if;
|
||||
|
||||
-- Generate assignments to initialize globals
|
||||
|
||||
Set_String (" Main_Priority := ");
|
||||
Set_Int (Main_Priority);
|
||||
Set_Char (';');
|
||||
|
|
@ -996,6 +1008,15 @@ package body Bindgen is
|
|||
|
||||
Gen_Elab_Calls;
|
||||
|
||||
-- Call System.Elaboration_Allocators.Mark_Start_Of_Elaboration if
|
||||
-- restriction No_Standard_Allocators_After_Elaboration is active.
|
||||
|
||||
if Cumulative_Restrictions.Set
|
||||
(No_Standard_Allocators_After_Elaboration)
|
||||
then
|
||||
WBI (" System.Elaboration_Allocators.Mark_End_Of_Elaboration;");
|
||||
end if;
|
||||
|
||||
-- From this point, no new dispatching domain can be created.
|
||||
|
||||
if Dispatching_Domains_Used then
|
||||
|
|
@ -2482,10 +2503,23 @@ package body Bindgen is
|
|||
WBI ("with System.Restrictions;");
|
||||
end if;
|
||||
|
||||
-- Generate with of Ada.Exceptions if needs library finalization
|
||||
|
||||
if Needs_Library_Finalization then
|
||||
WBI ("with Ada.Exceptions;");
|
||||
end if;
|
||||
|
||||
-- Generate with of System.Elaboration_Allocators if the restriction
|
||||
-- No_Standard_Allocators_After_Elaboration was present.
|
||||
|
||||
if Cumulative_Restrictions.Set
|
||||
(No_Standard_Allocators_After_Elaboration)
|
||||
then
|
||||
WBI ("with System.Elaboration_Allocators;");
|
||||
end if;
|
||||
|
||||
-- Generate start of package body
|
||||
|
||||
WBI ("");
|
||||
WBI ("package body " & Ada_Main & " is");
|
||||
WBI (" pragma Warnings (Off);");
|
||||
|
|
|
|||
|
|
@ -801,7 +801,7 @@ package body Exp_Attr is
|
|||
pragma Assert
|
||||
(Nkind (Parent (Loop_Stmt)) = N_Handled_Sequence_Of_Statements
|
||||
and then Nkind (Parent (Parent (Loop_Stmt))) =
|
||||
N_Block_Statement);
|
||||
N_Block_Statement);
|
||||
|
||||
Decls := Declarations (Parent (Parent (Loop_Stmt)));
|
||||
end if;
|
||||
|
|
@ -1022,6 +1022,19 @@ package body Exp_Attr is
|
|||
|
||||
if Present (Result) then
|
||||
Rewrite (Loop_Stmt, Result);
|
||||
|
||||
-- The insertion of condition actions associated with an iteration
|
||||
-- scheme is usually done by the expansion of loop statements. The
|
||||
-- expansion of Loop_Entry however reuses the iteration scheme to
|
||||
-- build an if statement. As a result any condition actions must be
|
||||
-- inserted before the if statement to avoid references before
|
||||
-- declaration.
|
||||
|
||||
if Present (Scheme) and then Present (Condition_Actions (Scheme)) then
|
||||
Insert_Actions (Loop_Stmt, Condition_Actions (Scheme));
|
||||
Set_Condition_Actions (Scheme, No_List);
|
||||
end if;
|
||||
|
||||
Analyze (Loop_Stmt);
|
||||
|
||||
-- The conditional block was analyzed when a previous 'Loop_Entry was
|
||||
|
|
|
|||
|
|
@ -4490,6 +4490,20 @@ package body Exp_Ch4 is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
-- If no storage pool has been specified and we have the restriction
|
||||
-- No_Standard_Allocators_After_Elaboration is present, then generate
|
||||
-- a call to Elaboration_Allocators.Check_Standard_Allocator.
|
||||
|
||||
if Nkind (N) = N_Allocator
|
||||
and then No (Storage_Pool (N))
|
||||
and then Restriction_Active (No_Standard_Allocators_After_Elaboration)
|
||||
then
|
||||
Insert_Action (N,
|
||||
Make_Procedure_Call_Statement (Loc,
|
||||
Name =>
|
||||
New_Occurrence_Of (RTE (RE_Check_Standard_Allocator), Loc)));
|
||||
end if;
|
||||
|
||||
-- Handle case of qualified expression (other than optimization above)
|
||||
-- First apply constraint checks, because the bounds or discriminants
|
||||
-- in the aggregate might not match the subtype mark in the allocator.
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2002-2010, AdaCore --
|
||||
-- Copyright (C) 2002-2014, AdaCore --
|
||||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -31,6 +31,9 @@
|
|||
|
||||
-- This is the VMS version
|
||||
|
||||
-- Note: there is far too much code duplication wrt g-expect.adb (the
|
||||
-- standard version). This should be factored out ???
|
||||
|
||||
with System; use System;
|
||||
with Ada.Calendar; use Ada.Calendar;
|
||||
|
||||
|
|
|
|||
|
|
@ -3769,7 +3769,37 @@ also suppress generation of cross-reference information
|
|||
|
||||
@item ^-gnateA^/ALIASING_CHECK^
|
||||
@cindex @option{-gnateA} (@command{gcc})
|
||||
Check that there is no aliasing between two parameters of the same subprogram.
|
||||
Check that the actual parameters of a subprogram call are not aliases of one
|
||||
another. To qualify as aliasing, the actuals must denote objects of a composite
|
||||
type, their memory locations must be identical or overlapping, and at least one
|
||||
of the corresponding formal parameters must be of mode OUT or IN OUT.
|
||||
|
||||
@smallexample
|
||||
type Rec_Typ is record
|
||||
Data : Integer := 0;
|
||||
end record;
|
||||
|
||||
function Self (Val : Rec_Typ) return Rec_Typ is
|
||||
begin
|
||||
return Val;
|
||||
end Self;
|
||||
|
||||
procedure Detect_Aliasing (Val_1 : in out Rec_Typ; Val_2 : Rec_Typ) is
|
||||
begin
|
||||
null;
|
||||
end Detect_Aliasing;
|
||||
|
||||
Obj : Rec_Typ;
|
||||
|
||||
Detect_Aliasing (Obj, Obj);
|
||||
Detect_Aliasing (Obj, Self (Obj));
|
||||
@end smallexample
|
||||
|
||||
In the example above, the first call to @code{Detect_Aliasing} fails with a
|
||||
@code{Program_Error} at runtime because the actuals for @code{Val_1} and
|
||||
@code{Val_2} denote the same object. The second call executes without raising
|
||||
an exception because @code{Self(Obj)} produces an anonymous object which does
|
||||
not share the memory location of @code{Obj}.
|
||||
|
||||
@item -gnatec=@var{path}
|
||||
@cindex @option{-gnatec} (@command{gcc})
|
||||
|
|
@ -3991,7 +4021,8 @@ support this switch.
|
|||
|
||||
@item ^-gnateV^/PARAMETER_VALIDITY_CHECK^
|
||||
@cindex @option{-gnateV} (@command{gcc})
|
||||
Check validity of subprogram parameters.
|
||||
Check that all actual parameters of a subprogram call are valid according to
|
||||
the rules of validity checking (@pxref{Validity Checking}).
|
||||
|
||||
@item ^-gnateY^/IGNORE_SUPPRESS_SYLE_CHECK_PRAGMAS^
|
||||
@cindex @option{-gnateY} (@command{gcc})
|
||||
|
|
|
|||
|
|
@ -214,7 +214,6 @@ package body Lib.Load is
|
|||
Expected_Unit => Spec_Name,
|
||||
Fatal_Error => True,
|
||||
Generate_Code => False,
|
||||
Has_Allocator => False,
|
||||
Has_RACW => False,
|
||||
Filler => False,
|
||||
Ident_String => Empty,
|
||||
|
|
@ -321,7 +320,6 @@ package body Lib.Load is
|
|||
Expected_Unit => No_Unit_Name,
|
||||
Fatal_Error => False,
|
||||
Generate_Code => False,
|
||||
Has_Allocator => False,
|
||||
Has_RACW => False,
|
||||
Filler => False,
|
||||
Ident_String => Empty,
|
||||
|
|
@ -685,7 +683,6 @@ package body Lib.Load is
|
|||
Expected_Unit => Uname_Actual,
|
||||
Fatal_Error => False,
|
||||
Generate_Code => False,
|
||||
Has_Allocator => False,
|
||||
Has_RACW => False,
|
||||
Filler => False,
|
||||
Ident_String => Empty,
|
||||
|
|
|
|||
|
|
@ -82,7 +82,6 @@ package body Lib.Writ is
|
|||
Dynamic_Elab => False,
|
||||
Fatal_Error => False,
|
||||
Generate_Code => False,
|
||||
Has_Allocator => False,
|
||||
Has_RACW => False,
|
||||
Filler => False,
|
||||
Ident_String => Empty,
|
||||
|
|
@ -140,7 +139,6 @@ package body Lib.Writ is
|
|||
Dynamic_Elab => False,
|
||||
Fatal_Error => False,
|
||||
Generate_Code => False,
|
||||
Has_Allocator => False,
|
||||
Has_RACW => False,
|
||||
Filler => False,
|
||||
Ident_String => Empty,
|
||||
|
|
@ -1020,10 +1018,6 @@ package body Lib.Writ is
|
|||
Write_Info_Nat (Opt.Time_Slice_Value);
|
||||
end if;
|
||||
|
||||
if Has_Allocator (Main_Unit) then
|
||||
Write_Info_Str (" AB");
|
||||
end if;
|
||||
|
||||
if Main_CPU (Main_Unit) /= Default_Main_CPU then
|
||||
Write_Info_Str (" C=");
|
||||
Write_Info_Nat (Main_CPU (Main_Unit));
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2014, 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- --
|
||||
|
|
@ -116,7 +116,7 @@ package Lib.Writ is
|
|||
-- -- M Main Program --
|
||||
-- ---------------------
|
||||
|
||||
-- M type [priority] [T=time-slice] [AB] [C=cpu] W=?
|
||||
-- M type [priority] [T=time-slice] [C=cpu] W=?
|
||||
|
||||
-- This line appears only if the main unit for this file is suitable
|
||||
-- for use as a main program. The parameters are:
|
||||
|
|
@ -141,14 +141,6 @@ package Lib.Writ is
|
|||
-- milliseconds. The actual significance of this parameter is
|
||||
-- target dependent.
|
||||
|
||||
-- AB
|
||||
|
||||
-- Present if there is an allocator in the body of the procedure
|
||||
-- after the BEGIN. This will be a violation of the restriction
|
||||
-- No_Allocators_After_Elaboration if it is present, and this
|
||||
-- unit is used as a main program (only the binder can find the
|
||||
-- violation, since only the binder knows the main program).
|
||||
|
||||
-- C=cpu
|
||||
|
||||
-- Present only if there was a valid pragma CPU in the
|
||||
|
|
|
|||
|
|
@ -116,11 +116,6 @@ package body Lib is
|
|||
return Units.Table (U).Generate_Code;
|
||||
end Generate_Code;
|
||||
|
||||
function Has_Allocator (U : Unit_Number_Type) return Boolean is
|
||||
begin
|
||||
return Units.Table (U).Has_Allocator;
|
||||
end Has_Allocator;
|
||||
|
||||
function Has_RACW (U : Unit_Number_Type) return Boolean is
|
||||
begin
|
||||
return Units.Table (U).Has_RACW;
|
||||
|
|
@ -206,11 +201,6 @@ package body Lib is
|
|||
Units.Table (U).Generate_Code := B;
|
||||
end Set_Generate_Code;
|
||||
|
||||
procedure Set_Has_Allocator (U : Unit_Number_Type; B : Boolean := True) is
|
||||
begin
|
||||
Units.Table (U).Has_Allocator := B;
|
||||
end Set_Has_Allocator;
|
||||
|
||||
procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True) is
|
||||
begin
|
||||
Units.Table (U).Has_RACW := B;
|
||||
|
|
|
|||
|
|
@ -316,10 +316,6 @@ package Lib is
|
|||
-- code is to be generated. This includes the unit explicitly compiled,
|
||||
-- together with its specification, and any subunits.
|
||||
|
||||
-- Has_Allocator
|
||||
-- This flag is set if a subprogram unit has an allocator after the
|
||||
-- BEGIN (it is used to set the AB flag in the M ALI line).
|
||||
|
||||
-- Has_RACW
|
||||
-- A Boolean flag, initially set to False when a unit entry is created,
|
||||
-- and set to True if the unit defines a remote access to class wide
|
||||
|
|
@ -409,7 +405,6 @@ package Lib is
|
|||
function Fatal_Error (U : Unit_Number_Type) return Boolean;
|
||||
function Generate_Code (U : Unit_Number_Type) return Boolean;
|
||||
function Ident_String (U : Unit_Number_Type) return Node_Id;
|
||||
function Has_Allocator (U : Unit_Number_Type) return Boolean;
|
||||
function Has_RACW (U : Unit_Number_Type) return Boolean;
|
||||
function Loading (U : Unit_Number_Type) return Boolean;
|
||||
function Main_CPU (U : Unit_Number_Type) return Int;
|
||||
|
|
@ -428,7 +423,6 @@ package Lib is
|
|||
procedure Set_Fatal_Error (U : Unit_Number_Type; B : Boolean := True);
|
||||
procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True);
|
||||
procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True);
|
||||
procedure Set_Has_Allocator (U : Unit_Number_Type; B : Boolean := True);
|
||||
procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id);
|
||||
procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True);
|
||||
procedure Set_Main_CPU (U : Unit_Number_Type; P : Int);
|
||||
|
|
@ -726,7 +720,6 @@ private
|
|||
pragma Inline (Dependency_Num);
|
||||
pragma Inline (Fatal_Error);
|
||||
pragma Inline (Generate_Code);
|
||||
pragma Inline (Has_Allocator);
|
||||
pragma Inline (Has_RACW);
|
||||
pragma Inline (Increment_Serial_Number);
|
||||
pragma Inline (Loading);
|
||||
|
|
@ -738,7 +731,6 @@ private
|
|||
pragma Inline (Set_Cunit_Entity);
|
||||
pragma Inline (Set_Fatal_Error);
|
||||
pragma Inline (Set_Generate_Code);
|
||||
pragma Inline (Set_Has_Allocator);
|
||||
pragma Inline (Set_Has_RACW);
|
||||
pragma Inline (Set_Loading);
|
||||
pragma Inline (Set_Main_CPU);
|
||||
|
|
@ -770,7 +762,6 @@ private
|
|||
Dynamic_Elab : Boolean;
|
||||
Filler : Boolean;
|
||||
Loading : Boolean;
|
||||
Has_Allocator : Boolean;
|
||||
OA_Setting : Character;
|
||||
SPARK_Mode_Pragma : Node_Id;
|
||||
end record;
|
||||
|
|
@ -798,10 +789,9 @@ private
|
|||
Generate_Code at 57 range 0 .. 7;
|
||||
Has_RACW at 58 range 0 .. 7;
|
||||
Dynamic_Elab at 59 range 0 .. 7;
|
||||
Filler at 60 range 0 .. 7;
|
||||
OA_Setting at 61 range 0 .. 7;
|
||||
Loading at 62 range 0 .. 7;
|
||||
Has_Allocator at 63 range 0 .. 7;
|
||||
Filler at 60 range 0 .. 15;
|
||||
OA_Setting at 62 range 0 .. 7;
|
||||
Loading at 63 range 0 .. 7;
|
||||
SPARK_Mode_Pragma at 64 range 0 .. 31;
|
||||
end record;
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2009-2013, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2009-2014, 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- --
|
||||
|
|
@ -357,7 +357,7 @@ package body Par_SCO is
|
|||
|
||||
function Is_Logical_Operator (N : Node_Id) return Boolean is
|
||||
begin
|
||||
return Nkind_In (N, N_Op_Not, N_And_Then, N_Or_Else);
|
||||
return Nkind_In (N, N_Op_Not, N_And_Then, N_Or_Else, N_If_Expression);
|
||||
end Is_Logical_Operator;
|
||||
|
||||
-----------------------
|
||||
|
|
|
|||
|
|
@ -241,6 +241,7 @@ package Rtsfind is
|
|||
System_Dim,
|
||||
System_DSA_Services,
|
||||
System_DSA_Types,
|
||||
System_Elaboration_Allocators,
|
||||
System_Exception_Table,
|
||||
System_Exceptions_Debug,
|
||||
System_Exn_Int,
|
||||
|
|
@ -856,6 +857,8 @@ package Rtsfind is
|
|||
|
||||
RE_Any_Container_Ptr, -- System.DSA_Types
|
||||
|
||||
RE_Check_Standard_Allocator, -- System.Elaboration_Allocators
|
||||
|
||||
RE_Register_Exception, -- System.Exception_Table
|
||||
|
||||
RE_Local_Raise, -- System.Exceptions_Debug
|
||||
|
|
@ -2141,6 +2144,8 @@ package Rtsfind is
|
|||
|
||||
RE_Any_Container_Ptr => System_DSA_Types,
|
||||
|
||||
RE_Check_Standard_Allocator => System_Elaboration_Allocators,
|
||||
|
||||
RE_Register_Exception => System_Exception_Table,
|
||||
|
||||
RE_Local_Raise => System_Exceptions_Debug,
|
||||
|
|
|
|||
|
|
@ -0,0 +1,72 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . E L A B O R A T I O N _ A L L O C A T O R S --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2014, 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. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
package body System.Elaboration_Allocators is
|
||||
|
||||
Elaboration_In_Progress : Boolean;
|
||||
pragma Atomic (Elaboration_In_Progress);
|
||||
-- Flag to show if elaboration is active. We don't attempt to initialize
|
||||
-- this because we want to be sure it gets reset if we are in a multiple
|
||||
-- elaboration situation of some kind. Make it atomic to prevent race
|
||||
-- conditions of any kind (not clearly necessary, but harmless!)
|
||||
|
||||
------------------------------
|
||||
-- Check_Standard_Allocator --
|
||||
------------------------------
|
||||
|
||||
procedure Check_Standard_Allocator is
|
||||
begin
|
||||
if not Elaboration_In_Progress then
|
||||
raise Program_Error with
|
||||
"standard allocator after elaboration is complete is not allowed "
|
||||
& "(No_Standard_Allocators_After_Elaboration restriction active)";
|
||||
end if;
|
||||
end Check_Standard_Allocator;
|
||||
|
||||
-----------------------------
|
||||
-- Mark_End_Of_Elaboration --
|
||||
-----------------------------
|
||||
|
||||
procedure Mark_End_Of_Elaboration is
|
||||
begin
|
||||
Elaboration_In_Progress := False;
|
||||
end Mark_End_Of_Elaboration;
|
||||
|
||||
-------------------------------
|
||||
-- Mark_Start_Of_Elaboration --
|
||||
-------------------------------
|
||||
|
||||
procedure Mark_Start_Of_Elaboration is
|
||||
begin
|
||||
Elaboration_In_Progress := True;
|
||||
end Mark_Start_Of_Elaboration;
|
||||
|
||||
end System.Elaboration_Allocators;
|
||||
|
|
@ -0,0 +1,57 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . E L A B O R A T I O N _ A L L O C A T O R S --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2014, 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 package provides the interfaces for proper handling of restriction
|
||||
-- No_Standard_Allocators_After_Elaboration. It is used only by programs
|
||||
-- which use this restriction.
|
||||
|
||||
package System.Elaboration_Allocators is
|
||||
pragma Preelaborate;
|
||||
|
||||
procedure Mark_Start_Of_Elaboration;
|
||||
-- Called right at the start of main elaboration if the program activates
|
||||
-- restriction No_Standard_Allocators_After_Elaboration. We don't want to
|
||||
-- rely on the normal elaboration mechanism for marking this event, since
|
||||
-- that would require us to be sure to elaborate this first, which would
|
||||
-- be awkward, and it is convenient to have this package be Preelaborate.
|
||||
|
||||
procedure Mark_End_Of_Elaboration;
|
||||
-- Called when main elaboration is complete if the program has activated
|
||||
-- restriction No_Standard_Allocators_After_Elaboration. This is the point
|
||||
-- beyond which any standard allocator use will violate the restriction.
|
||||
|
||||
procedure Check_Standard_Allocator;
|
||||
-- Called as part of every allocator in a program for which the restriction
|
||||
-- No_Standard_Allocators_After_Elaboration is active. This will raise an
|
||||
-- exception (Program_Error with an appropriate message) if it is called
|
||||
-- after the call to Mark_End_Of_Elaboration.
|
||||
|
||||
end System.Elaboration_Allocators;
|
||||
|
|
@ -10828,7 +10828,8 @@ package body Sem_Attr is
|
|||
-- may be a subtype (e.g. given by a slice).
|
||||
|
||||
-- Choices may also be identifiers with no staticness
|
||||
-- requirements, in which case rules are unclear???
|
||||
-- requirements, in which case they must resolve to the
|
||||
-- index type.
|
||||
|
||||
declare
|
||||
C : Node_Id;
|
||||
|
|
@ -10841,14 +10842,17 @@ package body Sem_Attr is
|
|||
Indx := First_Index (Etype (Prefix (N)));
|
||||
|
||||
if Nkind (C) /= N_Aggregate then
|
||||
Set_Etype (C, Etype (Indx));
|
||||
Analyze_And_Resolve (C, Etype (Indx));
|
||||
Apply_Constraint_Check (C, Etype (Indx));
|
||||
Check_Non_Static_Context (C);
|
||||
|
||||
else
|
||||
C_E := First (Expressions (C));
|
||||
while Present (C_E) loop
|
||||
Set_Etype (C_E, Etype (Indx));
|
||||
Analyze_And_Resolve (C_E, Etype (Indx));
|
||||
Apply_Constraint_Check (C_E, Etype (Indx));
|
||||
Check_Non_Static_Context (C_E);
|
||||
|
||||
Next (C_E);
|
||||
Next_Index (Indx);
|
||||
end loop;
|
||||
|
|
|
|||
|
|
@ -400,6 +400,7 @@ package body Sem_Ch4 is
|
|||
Type_Id : Entity_Id;
|
||||
P : Node_Id;
|
||||
C : Node_Id;
|
||||
Onode : Node_Id;
|
||||
|
||||
begin
|
||||
Check_SPARK_Restriction ("allocator is not allowed", N);
|
||||
|
|
@ -420,33 +421,40 @@ package body Sem_Ch4 is
|
|||
P := Parent (C);
|
||||
while Present (P) loop
|
||||
|
||||
-- In both cases we need a handled sequence of statements, where
|
||||
-- the occurrence of the allocator is within the statements.
|
||||
-- For the task case we need a handled sequence of statements,
|
||||
-- where the occurrence of the allocator is within the statements
|
||||
-- and the parent is a task body
|
||||
|
||||
if Nkind (P) = N_Handled_Sequence_Of_Statements
|
||||
and then Is_List_Member (C)
|
||||
and then List_Containing (C) = Statements (P)
|
||||
then
|
||||
Onode := Original_Node (Parent (P));
|
||||
|
||||
-- Check for allocator within task body, this is a definite
|
||||
-- violation of No_Allocators_After_Elaboration we can detect
|
||||
-- at compile time.
|
||||
|
||||
if Nkind (Original_Node (Parent (P))) = N_Task_Body then
|
||||
if Nkind (Onode) = N_Task_Body then
|
||||
Check_Restriction
|
||||
(No_Standard_Allocators_After_Elaboration, N);
|
||||
exit;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- The other case is appearance in a subprogram body. This may
|
||||
-- be a violation if this is a library level subprogram, and it
|
||||
-- turns out to be used as the main program, but only the
|
||||
-- binder knows that, so just record the occurrence.
|
||||
-- The other case is appearance in a subprogram body. This is
|
||||
-- a violation if this is a library level subprogram with no
|
||||
-- parameters. Note that this is now a static error even if the
|
||||
-- subprogram is not the main program (this is a change, in an
|
||||
-- earlier version only the main program was affected, and the
|
||||
-- check had to be done in the binder.
|
||||
|
||||
if Nkind (Original_Node (Parent (P))) = N_Subprogram_Body
|
||||
and then Nkind (Parent (Parent (P))) = N_Compilation_Unit
|
||||
then
|
||||
Set_Has_Allocator (Current_Sem_Unit);
|
||||
end if;
|
||||
if Nkind (P) = N_Subprogram_Body
|
||||
and then Nkind (Parent (P)) = N_Compilation_Unit
|
||||
and then No (Parameter_Specifications (Specification (P)))
|
||||
then
|
||||
Check_Restriction
|
||||
(No_Standard_Allocators_After_Elaboration, N);
|
||||
end if;
|
||||
|
||||
C := P;
|
||||
|
|
|
|||
|
|
@ -1087,9 +1087,13 @@ package body Sem_Util is
|
|||
-- If T is non-private but its base type is private, this is the
|
||||
-- completion of a subtype declaration whose parent type is private
|
||||
-- (see Complete_Private_Subtype in Sem_Ch3). The proper discriminants
|
||||
-- are to be found in the full view of the base.
|
||||
-- are to be found in the full view of the base. Check that the private
|
||||
-- status of T and its base differ.
|
||||
|
||||
if Is_Private_Type (Bas) and then Present (Full_View (Bas)) then
|
||||
if Is_Private_Type (Bas)
|
||||
and then not Is_Private_Type (T)
|
||||
and then Present (Full_View (Bas))
|
||||
then
|
||||
Bas := Full_View (Bas);
|
||||
end if;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue