015-02-05 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb (Add_Invariants): Don't assume invariant is standard Boolean. * sem_prag.adb (Analyze_Pragma, case Check): Don't assume condition is standard Boolean, it can be non-standard derived Boolean. 2015-02-05 Robert Dewar <dewar@adacore.com> * checks.adb (Enable_Range_Check): Disconnect attempted optimization for the case of range check for subscript of unconstrained array. 2015-02-05 Robert Dewar <dewar@adacore.com> * par-ch13.adb (With_Present): New function (Aspect_Specifications_Present): Handle WHEN in place of WITH (Get_Aspect_Specifications): Comment update. * par.adb: Comment updates. 2015-02-05 Robert Dewar <dewar@adacore.com> * errout.adb (Handle_Serious_Error): New setting of Fatal_Error. * frontend.adb (Frontend): New setting of Fatal_Error. * lib-load.adb (Create_Dummy_Package_Unit): New setting of Fatal_Error. (Load_Main_Source): New setting of Fatal_Error (Load_Unit): New setting of Fatal_Error. * lib-writ.adb (Add_Preprocessing_Dependency): New setting of Fatal_Error. (Ensure_System_Dependency): New setting of Fatal_Error. * lib.adb (Fatal_Error): New setting of Fatal_Error (Set_Fatal_Error): New setting of Fatal_Error. * lib.ads: New definition of Fatal_Error and associated routines. * par-ch10.adb (P_Compilation_Unit): New setting of Fatal_Error. * par-load.adb (Load): New setting of Fatal_Error. * rtsfind.adb (Load_RTU): New setting of Fatal_Error. * sem_ch10.adb (Analyze_Compilation_Unit): New setting of Fatal_Error. (Optional_Subunit): New setting of Fatal_Error. (Analyze_Proper_Body): New setting of Fatal_Error. (Load_Needed_Body): New setting of Fatal_Error. 2015-02-05 Ed Schonberg <schonberg@adacore.com> * sem_res.adb (Resolve_Call): If the function being called has out parameters do not check for language version if the function comes from a predefined unit, as those are always compiled in Ada 2012 mode. 2015-02-05 Ed Schonberg <schonberg@adacore.com> * sem_ch3.adb (Process_Full_View): Verify that the full view of a type extension must carry an explicit limited keyword if the partial view does (RM 7.3 (10.1)). From-SVN: r220446
This commit is contained in:
parent
c93f201145
commit
ef2c20e73c
|
@ -1,3 +1,60 @@
|
||||||
|
2015-02-05 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
|
* sem_ch13.adb (Add_Invariants): Don't assume invariant is
|
||||||
|
standard Boolean.
|
||||||
|
* sem_prag.adb (Analyze_Pragma, case Check): Don't assume
|
||||||
|
condition is standard Boolean, it can be non-standard derived
|
||||||
|
Boolean.
|
||||||
|
|
||||||
|
2015-02-05 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
|
* checks.adb (Enable_Range_Check): Disconnect attempted
|
||||||
|
optimization for the case of range check for subscript of
|
||||||
|
unconstrained array.
|
||||||
|
|
||||||
|
2015-02-05 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
|
* par-ch13.adb (With_Present): New function
|
||||||
|
(Aspect_Specifications_Present): Handle WHEN in place of WITH
|
||||||
|
(Get_Aspect_Specifications): Comment update.
|
||||||
|
* par.adb: Comment updates.
|
||||||
|
|
||||||
|
2015-02-05 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
|
* errout.adb (Handle_Serious_Error): New setting of Fatal_Error.
|
||||||
|
* frontend.adb (Frontend): New setting of Fatal_Error.
|
||||||
|
* lib-load.adb (Create_Dummy_Package_Unit): New setting of
|
||||||
|
Fatal_Error.
|
||||||
|
(Load_Main_Source): New setting of Fatal_Error
|
||||||
|
(Load_Unit): New setting of Fatal_Error.
|
||||||
|
* lib-writ.adb (Add_Preprocessing_Dependency): New setting of
|
||||||
|
Fatal_Error.
|
||||||
|
(Ensure_System_Dependency): New setting of Fatal_Error.
|
||||||
|
* lib.adb (Fatal_Error): New setting of Fatal_Error
|
||||||
|
(Set_Fatal_Error): New setting of Fatal_Error.
|
||||||
|
* lib.ads: New definition of Fatal_Error and associated routines.
|
||||||
|
* par-ch10.adb (P_Compilation_Unit): New setting of Fatal_Error.
|
||||||
|
* par-load.adb (Load): New setting of Fatal_Error.
|
||||||
|
* rtsfind.adb (Load_RTU): New setting of Fatal_Error.
|
||||||
|
* sem_ch10.adb (Analyze_Compilation_Unit): New setting of
|
||||||
|
Fatal_Error.
|
||||||
|
(Optional_Subunit): New setting of Fatal_Error.
|
||||||
|
(Analyze_Proper_Body): New setting of Fatal_Error.
|
||||||
|
(Load_Needed_Body): New setting of Fatal_Error.
|
||||||
|
|
||||||
|
2015-02-05 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
|
* sem_res.adb (Resolve_Call): If the function being called has
|
||||||
|
out parameters do not check for language version if the function
|
||||||
|
comes from a predefined unit, as those are always compiled in
|
||||||
|
Ada 2012 mode.
|
||||||
|
|
||||||
|
2015-02-05 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
|
* sem_ch3.adb (Process_Full_View): Verify that the full view
|
||||||
|
of a type extension must carry an explicit limited keyword if
|
||||||
|
the partial view does (RM 7.3 (10.1)).
|
||||||
|
|
||||||
2015-02-05 Robert Dewar <dewar@adacore.com>
|
2015-02-05 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
* g-rannum.adb, g-rannum.ads, s-rannum.adb, s-rannum.ads,
|
* g-rannum.adb, g-rannum.ads, s-rannum.adb, s-rannum.ads,
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- 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 --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -5521,10 +5521,14 @@ package body Checks is
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Ditto if the prefix is an explicit dereference whose designated
|
-- Ditto if prefix is simply an unconstrained array. We used
|
||||||
-- type is unconstrained.
|
-- to think this case was OK, if the prefix was not an explicit
|
||||||
|
-- dereference, but we have now seen a case where this is not
|
||||||
|
-- true, so it is safer to just suppress the optimization in this
|
||||||
|
-- case. The back end is getting better at eliminating redundant
|
||||||
|
-- checks in any case, so the loss won't be important.
|
||||||
|
|
||||||
elsif Nkind (Prefix (P)) = N_Explicit_Dereference
|
elsif Is_Array_Type (Atyp)
|
||||||
and then not Is_Constrained (Atyp)
|
and then not Is_Constrained (Atyp)
|
||||||
then
|
then
|
||||||
Activate_Range_Check (N);
|
Activate_Range_Check (N);
|
||||||
|
|
|
@ -753,12 +753,23 @@ package body Errout is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Set the fatal error flag in the unit table unless we are in
|
-- Set the fatal error flag in the unit table unless we are in
|
||||||
-- Try_Semantics mode. This stops the semantics from being performed
|
-- Try_Semantics mode (in which case we set ignored mode if not
|
||||||
|
-- currently set. This stops the semantics from being performed
|
||||||
-- if we find a serious error. This is skipped if we are currently
|
-- if we find a serious error. This is skipped if we are currently
|
||||||
-- dealing with the configuration pragma file.
|
-- dealing with the configuration pragma file.
|
||||||
|
|
||||||
if not Try_Semantics and then Current_Source_Unit /= No_Unit then
|
if Current_Source_Unit /= No_Unit then
|
||||||
Set_Fatal_Error (Get_Source_Unit (Sptr));
|
declare
|
||||||
|
U : constant Unit_Number_Type := Get_Source_Unit (Sptr);
|
||||||
|
begin
|
||||||
|
if Try_Semantics then
|
||||||
|
if Fatal_Error (U) = None then
|
||||||
|
Set_Fatal_Error (U, Error_Ignored);
|
||||||
|
end if;
|
||||||
|
else
|
||||||
|
Set_Fatal_Error (U, Error_Detected);
|
||||||
|
end if;
|
||||||
|
end;
|
||||||
end if;
|
end if;
|
||||||
end Handle_Serious_Error;
|
end Handle_Serious_Error;
|
||||||
|
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- 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 --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -338,7 +338,7 @@ begin
|
||||||
-- unit failed to load, to avoid cascaded inconsistencies that can lead
|
-- unit failed to load, to avoid cascaded inconsistencies that can lead
|
||||||
-- to a compiler crash.
|
-- to a compiler crash.
|
||||||
|
|
||||||
and then not Fatal_Error (Main_Unit)
|
and then Fatal_Error (Main_Unit) /= Error_Detected
|
||||||
then
|
then
|
||||||
-- Pragmas that require some semantic activity, such as Interrupt_State,
|
-- Pragmas that require some semantic activity, such as Interrupt_State,
|
||||||
-- cannot be processed until the main unit is installed, because they
|
-- cannot be processed until the main unit is installed, because they
|
||||||
|
@ -388,7 +388,7 @@ begin
|
||||||
|
|
||||||
-- Following steps are skipped if we had a fatal error during parsing
|
-- Following steps are skipped if we had a fatal error during parsing
|
||||||
|
|
||||||
if not Fatal_Error (Main_Unit) then
|
if Fatal_Error (Main_Unit) /= Error_Detected then
|
||||||
|
|
||||||
-- Reset Operating_Mode to Check_Semantics for subunits. We cannot
|
-- Reset Operating_Mode to Check_Semantics for subunits. We cannot
|
||||||
-- actually generate code for subunits, so we suppress expansion.
|
-- actually generate code for subunits, so we suppress expansion.
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- 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 --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -212,7 +212,7 @@ package body Lib.Load is
|
||||||
Dynamic_Elab => False,
|
Dynamic_Elab => False,
|
||||||
Error_Location => Sloc (With_Node),
|
Error_Location => Sloc (With_Node),
|
||||||
Expected_Unit => Spec_Name,
|
Expected_Unit => Spec_Name,
|
||||||
Fatal_Error => True,
|
Fatal_Error => Error_Detected,
|
||||||
Generate_Code => False,
|
Generate_Code => False,
|
||||||
Has_RACW => False,
|
Has_RACW => False,
|
||||||
Filler => False,
|
Filler => False,
|
||||||
|
@ -319,7 +319,7 @@ package body Lib.Load is
|
||||||
Dynamic_Elab => False,
|
Dynamic_Elab => False,
|
||||||
Error_Location => No_Location,
|
Error_Location => No_Location,
|
||||||
Expected_Unit => No_Unit_Name,
|
Expected_Unit => No_Unit_Name,
|
||||||
Fatal_Error => False,
|
Fatal_Error => None,
|
||||||
Generate_Code => False,
|
Generate_Code => False,
|
||||||
Has_RACW => False,
|
Has_RACW => False,
|
||||||
Filler => False,
|
Filler => False,
|
||||||
|
@ -683,7 +683,7 @@ package body Lib.Load is
|
||||||
Dynamic_Elab => False,
|
Dynamic_Elab => False,
|
||||||
Error_Location => Sloc (Error_Node),
|
Error_Location => Sloc (Error_Node),
|
||||||
Expected_Unit => Uname_Actual,
|
Expected_Unit => Uname_Actual,
|
||||||
Fatal_Error => False,
|
Fatal_Error => None,
|
||||||
Generate_Code => False,
|
Generate_Code => False,
|
||||||
Has_RACW => False,
|
Has_RACW => False,
|
||||||
Filler => False,
|
Filler => False,
|
||||||
|
@ -742,10 +742,20 @@ package body Lib.Load is
|
||||||
|
|
||||||
-- If loaded unit had a fatal error, then caller inherits it
|
-- If loaded unit had a fatal error, then caller inherits it
|
||||||
|
|
||||||
if Units.Table (Unum).Fatal_Error
|
if Present (Error_Node) then
|
||||||
and then Present (Error_Node)
|
case Units.Table (Unum).Fatal_Error is
|
||||||
then
|
when None =>
|
||||||
Units.Table (Calling_Unit).Fatal_Error := True;
|
null;
|
||||||
|
|
||||||
|
when Error_Detected =>
|
||||||
|
Units.Table (Calling_Unit).Fatal_Error := Error_Detected;
|
||||||
|
|
||||||
|
when Error_Ignored =>
|
||||||
|
if Units.Table (Calling_Unit).Fatal_Error = None then
|
||||||
|
Units.Table (Calling_Unit).Fatal_Error :=
|
||||||
|
Error_Ignored;
|
||||||
|
end if;
|
||||||
|
end case;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Remove load stack entry and return the entry in the file table
|
-- Remove load stack entry and return the entry in the file table
|
||||||
|
|
|
@ -81,7 +81,7 @@ package body Lib.Writ is
|
||||||
Cunit_Entity => Empty,
|
Cunit_Entity => Empty,
|
||||||
Dependency_Num => 0,
|
Dependency_Num => 0,
|
||||||
Dynamic_Elab => False,
|
Dynamic_Elab => False,
|
||||||
Fatal_Error => False,
|
Fatal_Error => None,
|
||||||
Generate_Code => False,
|
Generate_Code => False,
|
||||||
Has_RACW => False,
|
Has_RACW => False,
|
||||||
Filler => False,
|
Filler => False,
|
||||||
|
@ -139,7 +139,7 @@ package body Lib.Writ is
|
||||||
Cunit_Entity => Empty,
|
Cunit_Entity => Empty,
|
||||||
Dependency_Num => 0,
|
Dependency_Num => 0,
|
||||||
Dynamic_Elab => False,
|
Dynamic_Elab => False,
|
||||||
Fatal_Error => False,
|
Fatal_Error => None,
|
||||||
Generate_Code => False,
|
Generate_Code => False,
|
||||||
Has_RACW => False,
|
Has_RACW => False,
|
||||||
Filler => False,
|
Filler => False,
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- 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 --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -106,7 +106,7 @@ package body Lib is
|
||||||
return Units.Table (U).Expected_Unit;
|
return Units.Table (U).Expected_Unit;
|
||||||
end Expected_Unit;
|
end Expected_Unit;
|
||||||
|
|
||||||
function Fatal_Error (U : Unit_Number_Type) return Boolean is
|
function Fatal_Error (U : Unit_Number_Type) return Fatal_Type is
|
||||||
begin
|
begin
|
||||||
return Units.Table (U).Fatal_Error;
|
return Units.Table (U).Fatal_Error;
|
||||||
end Fatal_Error;
|
end Fatal_Error;
|
||||||
|
@ -196,9 +196,9 @@ package body Lib is
|
||||||
Units.Table (U).Error_Location := W;
|
Units.Table (U).Error_Location := W;
|
||||||
end Set_Error_Location;
|
end Set_Error_Location;
|
||||||
|
|
||||||
procedure Set_Fatal_Error (U : Unit_Number_Type; B : Boolean := True) is
|
procedure Set_Fatal_Error (U : Unit_Number_Type; V : Fatal_Type) is
|
||||||
begin
|
begin
|
||||||
Units.Table (U).Fatal_Error := B;
|
Units.Table (U).Fatal_Error := V;
|
||||||
end Set_Fatal_Error;
|
end Set_Fatal_Error;
|
||||||
|
|
||||||
procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True) is
|
procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True) is
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- S p e c --
|
-- 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 --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -302,7 +302,7 @@ package Lib is
|
||||||
-- No_Name for the main unit.
|
-- No_Name for the main unit.
|
||||||
|
|
||||||
-- Fatal_Error
|
-- Fatal_Error
|
||||||
-- A flag that is initialized to False, and gets set to True if a fatal
|
-- A flag that is initialized to None and gets set to Errorif a fatal
|
||||||
-- error occurs during the processing of a unit. A fatal error is one
|
-- error occurs during the processing of a unit. A fatal error is one
|
||||||
-- defined as serious enough to stop the next phase of the compiler
|
-- defined as serious enough to stop the next phase of the compiler
|
||||||
-- from running (i.e. fatal error during parsing stops semantics,
|
-- from running (i.e. fatal error during parsing stops semantics,
|
||||||
|
@ -310,6 +310,7 @@ package Lib is
|
||||||
-- currently, errors of any kind cause Fatal_Error to be set, but
|
-- currently, errors of any kind cause Fatal_Error to be set, but
|
||||||
-- eventually perhaps only errors labeled as fatal errors should be
|
-- eventually perhaps only errors labeled as fatal errors should be
|
||||||
-- this severe if we decide to try Sem on sources with minor errors.
|
-- this severe if we decide to try Sem on sources with minor errors.
|
||||||
|
-- There are three settings (see declaration of Fatal_Type).
|
||||||
|
|
||||||
-- Generate_Code
|
-- Generate_Code
|
||||||
-- This flag is set True for all units in the current file for which
|
-- This flag is set True for all units in the current file for which
|
||||||
|
@ -401,13 +402,29 @@ package Lib is
|
||||||
Default_Main_CPU : constant Int := -1;
|
Default_Main_CPU : constant Int := -1;
|
||||||
-- Value used in Main_CPU field to indicate default main affinity
|
-- Value used in Main_CPU field to indicate default main affinity
|
||||||
|
|
||||||
|
-- The following defines settings for the Fatal_Error field
|
||||||
|
|
||||||
|
type Fatal_Type is (
|
||||||
|
None,
|
||||||
|
-- No error detected for this unit
|
||||||
|
|
||||||
|
Error_Detected,
|
||||||
|
-- Fatal error detected that prevents moving to the next phase. For
|
||||||
|
-- example, a fatal error during parsing inhibits semantic analysis.
|
||||||
|
|
||||||
|
Error_Ignored);
|
||||||
|
-- A fatal error was detected, but we are in Try_Semantics mode (as set
|
||||||
|
-- by -gnatq or -gnatQ). This does not stop the compiler from proceding,
|
||||||
|
-- but tools can use this status (e.g. ASIS looking at the generated
|
||||||
|
-- tree) to know that a fatal error was detected.
|
||||||
|
|
||||||
function Cunit (U : Unit_Number_Type) return Node_Id;
|
function Cunit (U : Unit_Number_Type) return Node_Id;
|
||||||
function Cunit_Entity (U : Unit_Number_Type) return Entity_Id;
|
function Cunit_Entity (U : Unit_Number_Type) return Entity_Id;
|
||||||
function Dependency_Num (U : Unit_Number_Type) return Nat;
|
function Dependency_Num (U : Unit_Number_Type) return Nat;
|
||||||
function Dynamic_Elab (U : Unit_Number_Type) return Boolean;
|
function Dynamic_Elab (U : Unit_Number_Type) return Boolean;
|
||||||
function Error_Location (U : Unit_Number_Type) return Source_Ptr;
|
function Error_Location (U : Unit_Number_Type) return Source_Ptr;
|
||||||
function Expected_Unit (U : Unit_Number_Type) return Unit_Name_Type;
|
function Expected_Unit (U : Unit_Number_Type) return Unit_Name_Type;
|
||||||
function Fatal_Error (U : Unit_Number_Type) return Boolean;
|
function Fatal_Error (U : Unit_Number_Type) return Fatal_Type;
|
||||||
function Generate_Code (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 Ident_String (U : Unit_Number_Type) return Node_Id;
|
||||||
function Has_RACW (U : Unit_Number_Type) return Boolean;
|
function Has_RACW (U : Unit_Number_Type) return Boolean;
|
||||||
|
@ -422,20 +439,20 @@ package Lib is
|
||||||
function Unit_Name (U : Unit_Number_Type) return Unit_Name_Type;
|
function Unit_Name (U : Unit_Number_Type) return Unit_Name_Type;
|
||||||
-- Get value of named field from given units table entry
|
-- Get value of named field from given units table entry
|
||||||
|
|
||||||
procedure Set_Cunit (U : Unit_Number_Type; N : Node_Id);
|
procedure Set_Cunit (U : Unit_Number_Type; N : Node_Id);
|
||||||
procedure Set_Cunit_Entity (U : Unit_Number_Type; E : Entity_Id);
|
procedure Set_Cunit_Entity (U : Unit_Number_Type; E : Entity_Id);
|
||||||
procedure Set_Dynamic_Elab (U : Unit_Number_Type; B : Boolean := True);
|
procedure Set_Dynamic_Elab (U : Unit_Number_Type; B : Boolean := True);
|
||||||
procedure Set_Error_Location (U : Unit_Number_Type; W : Source_Ptr);
|
procedure Set_Error_Location (U : Unit_Number_Type; W : Source_Ptr);
|
||||||
procedure Set_Fatal_Error (U : Unit_Number_Type; B : Boolean := True);
|
procedure Set_Fatal_Error (U : Unit_Number_Type; V : Fatal_Type);
|
||||||
procedure Set_Generate_Code (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_RACW (U : Unit_Number_Type; B : Boolean := True);
|
||||||
procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id);
|
procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id);
|
||||||
procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True);
|
procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True);
|
||||||
procedure Set_Main_CPU (U : Unit_Number_Type; P : Int);
|
procedure Set_Main_CPU (U : Unit_Number_Type; P : Int);
|
||||||
procedure Set_No_Elab_Code_All (U : Unit_Number_Type; B : Boolean := True);
|
procedure Set_No_Elab_Code_All (U : Unit_Number_Type; B : Boolean := True);
|
||||||
procedure Set_Main_Priority (U : Unit_Number_Type; P : Int);
|
procedure Set_Main_Priority (U : Unit_Number_Type; P : Int);
|
||||||
procedure Set_OA_Setting (U : Unit_Number_Type; C : Character);
|
procedure Set_OA_Setting (U : Unit_Number_Type; C : Character);
|
||||||
procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type);
|
procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type);
|
||||||
-- Set value of named field for given units table entry. Note that we
|
-- Set value of named field for given units table entry. Note that we
|
||||||
-- do not have an entry for each possible field, since some of the fields
|
-- do not have an entry for each possible field, since some of the fields
|
||||||
-- can only be set by specialized interfaces (defined below).
|
-- can only be set by specialized interfaces (defined below).
|
||||||
|
@ -606,7 +623,7 @@ package Lib is
|
||||||
function Is_Loaded (Uname : Unit_Name_Type) return Boolean;
|
function Is_Loaded (Uname : Unit_Name_Type) return Boolean;
|
||||||
-- Determines if unit with given name is already loaded, i.e. there is
|
-- Determines if unit with given name is already loaded, i.e. there is
|
||||||
-- already an entry in the file table with this unit name for which the
|
-- already an entry in the file table with this unit name for which the
|
||||||
-- corresponding file was found and parsed. Note that the Fatal_Error flag
|
-- corresponding file was found and parsed. Note that the Fatal_Error value
|
||||||
-- of this entry must be checked before proceeding with further processing.
|
-- of this entry must be checked before proceeding with further processing.
|
||||||
|
|
||||||
function Last_Unit return Unit_Number_Type;
|
function Last_Unit return Unit_Number_Type;
|
||||||
|
@ -767,7 +784,7 @@ private
|
||||||
Serial_Number : Nat;
|
Serial_Number : Nat;
|
||||||
Version : Word;
|
Version : Word;
|
||||||
Error_Location : Source_Ptr;
|
Error_Location : Source_Ptr;
|
||||||
Fatal_Error : Boolean;
|
Fatal_Error : Fatal_Type;
|
||||||
Generate_Code : Boolean;
|
Generate_Code : Boolean;
|
||||||
Has_RACW : Boolean;
|
Has_RACW : Boolean;
|
||||||
Dynamic_Elab : Boolean;
|
Dynamic_Elab : Boolean;
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- 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 --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -596,7 +596,7 @@ package body Ch10 is
|
||||||
|
|
||||||
else
|
else
|
||||||
Cunit_Error_Flag := True;
|
Cunit_Error_Flag := True;
|
||||||
Set_Fatal_Error (Current_Source_Unit);
|
Set_Fatal_Error (Current_Source_Unit, Error_Detected);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Clear away any missing semicolon indication, we are done with that
|
-- Clear away any missing semicolon indication, we are done with that
|
||||||
|
@ -726,7 +726,7 @@ package body Ch10 is
|
||||||
-- cascaded messages in some situations.
|
-- cascaded messages in some situations.
|
||||||
|
|
||||||
else
|
else
|
||||||
if not Fatal_Error (Current_Source_Unit) then
|
if Fatal_Error (Current_Source_Unit) /= Error_Detected then
|
||||||
if Token in Token_Class_Cunit then
|
if Token in Token_Class_Cunit then
|
||||||
Error_Msg_SC
|
Error_Msg_SC
|
||||||
("end of file expected, " &
|
("end of file expected, " &
|
||||||
|
@ -758,7 +758,7 @@ package body Ch10 is
|
||||||
-- An error resync is a serious bomb, so indicate result unit no good
|
-- An error resync is a serious bomb, so indicate result unit no good
|
||||||
|
|
||||||
when Error_Resync =>
|
when Error_Resync =>
|
||||||
Set_Fatal_Error (Current_Source_Unit);
|
Set_Fatal_Error (Current_Source_Unit, Error_Detected);
|
||||||
return Error;
|
return Error;
|
||||||
end P_Compilation_Unit;
|
end P_Compilation_Unit;
|
||||||
|
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- 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 --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -48,6 +48,10 @@ package body Ch13 is
|
||||||
function Possible_Misspelled_Aspect return Boolean;
|
function Possible_Misspelled_Aspect return Boolean;
|
||||||
-- Returns True, if Token_Name is a misspelling of some aspect name
|
-- Returns True, if Token_Name is a misspelling of some aspect name
|
||||||
|
|
||||||
|
function With_Present return Boolean;
|
||||||
|
-- Returns True if WITH is present, indicating presence of aspect
|
||||||
|
-- specifications. Also allows incorrect use of WHEN in place of WITH.
|
||||||
|
|
||||||
--------------------------------
|
--------------------------------
|
||||||
-- Possible_Misspelled_Aspect --
|
-- Possible_Misspelled_Aspect --
|
||||||
--------------------------------
|
--------------------------------
|
||||||
|
@ -63,6 +67,43 @@ package body Ch13 is
|
||||||
return False;
|
return False;
|
||||||
end Possible_Misspelled_Aspect;
|
end Possible_Misspelled_Aspect;
|
||||||
|
|
||||||
|
------------------
|
||||||
|
-- With_Present --
|
||||||
|
------------------
|
||||||
|
|
||||||
|
function With_Present return Boolean is
|
||||||
|
begin
|
||||||
|
if Token = Tok_With then
|
||||||
|
return True;
|
||||||
|
|
||||||
|
-- Check for WHEN used in place of WITH
|
||||||
|
|
||||||
|
elsif Token = Tok_When then
|
||||||
|
declare
|
||||||
|
Scan_State : Saved_Scan_State;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Save_Scan_State (Scan_State);
|
||||||
|
Scan; -- past WHEN
|
||||||
|
|
||||||
|
if Token = Tok_Identifier
|
||||||
|
and then Get_Aspect_Id (Token_Name) /= No_Aspect
|
||||||
|
then
|
||||||
|
Error_Msg_SC ("WHEN should be WITH");
|
||||||
|
Restore_Scan_State (Scan_State);
|
||||||
|
return True;
|
||||||
|
|
||||||
|
else
|
||||||
|
Restore_Scan_State (Scan_State);
|
||||||
|
return False;
|
||||||
|
end if;
|
||||||
|
end;
|
||||||
|
|
||||||
|
else
|
||||||
|
return False;
|
||||||
|
end if;
|
||||||
|
end With_Present;
|
||||||
|
|
||||||
-- Start of processing for Aspect_Specifications_Present
|
-- Start of processing for Aspect_Specifications_Present
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
@ -79,14 +120,15 @@ package body Ch13 is
|
||||||
-- be too expensive. Instead we pick up the aspect specifications later
|
-- be too expensive. Instead we pick up the aspect specifications later
|
||||||
-- as a bogus declaration, and diagnose the semicolon at that point.
|
-- as a bogus declaration, and diagnose the semicolon at that point.
|
||||||
|
|
||||||
if Token /= Tok_With then
|
if not With_Present then
|
||||||
return False;
|
return False;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Have a WITH, see if it looks like an aspect specification
|
-- Have a WITH or some token that we accept as a legitimate bad attempt
|
||||||
|
-- at writing WITH. See if it looks like an aspect specification
|
||||||
|
|
||||||
Save_Scan_State (Scan_State);
|
Save_Scan_State (Scan_State);
|
||||||
Scan; -- past WITH
|
Scan; -- past WITH (or WHEN or other bad keyword)
|
||||||
|
|
||||||
-- If no identifier, then consider that we definitely do not have an
|
-- If no identifier, then consider that we definitely do not have an
|
||||||
-- aspect specification.
|
-- aspect specification.
|
||||||
|
@ -193,7 +235,7 @@ package body Ch13 is
|
||||||
return Aspects;
|
return Aspects;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Scan; -- past WITH
|
Scan; -- past WITH (or possible WHEN after error)
|
||||||
Aspects := Empty_List;
|
Aspects := Empty_List;
|
||||||
|
|
||||||
-- Loop to scan aspects
|
-- Loop to scan aspects
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- 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 --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -127,7 +127,7 @@ procedure Load is
|
||||||
begin
|
begin
|
||||||
-- Don't do any loads if we already had a fatal error
|
-- Don't do any loads if we already had a fatal error
|
||||||
|
|
||||||
if Fatal_Error (Cur_Unum) then
|
if Fatal_Error (Cur_Unum) = Error_Detected then
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- 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 --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -951,6 +951,9 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
|
||||||
-- permitted). Note: this routine never checks the terminator token
|
-- permitted). Note: this routine never checks the terminator token
|
||||||
-- for aspects so it does not matter whether the aspect specifications
|
-- for aspects so it does not matter whether the aspect specifications
|
||||||
-- are terminated by semicolon or some other character.
|
-- are terminated by semicolon or some other character.
|
||||||
|
--
|
||||||
|
-- Note: This function also handles the case of WHEN used where WITH
|
||||||
|
-- was intended, and in that case posts an error and returns True.
|
||||||
|
|
||||||
procedure P_Aspect_Specifications
|
procedure P_Aspect_Specifications
|
||||||
(Decl : Node_Id;
|
(Decl : Node_Id;
|
||||||
|
@ -960,15 +963,17 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
|
||||||
-- argument is False, the scan pointer is left pointing past the aspects
|
-- argument is False, the scan pointer is left pointing past the aspects
|
||||||
-- and the caller must check for a proper terminator.
|
-- and the caller must check for a proper terminator.
|
||||||
--
|
--
|
||||||
-- P_Aspect_Specifications is called with the current token pointing to
|
-- P_Aspect_Specifications is called with the current token pointing
|
||||||
-- either a WITH keyword starting an aspect specification, or an
|
-- to either a WITH keyword starting an aspect specification, or an
|
||||||
-- instance of the terminator token. In the former case, the aspect
|
-- instance of what shpould be a terminator token. In the former case,
|
||||||
-- specifications are scanned out including the terminator token if it
|
-- the aspect specifications are scanned out including the terminator
|
||||||
-- it is a semicolon, and the Has_Aspect_Specifications flag is set in
|
-- token if it it is a semicolon, and the Has_Aspect_Specifications
|
||||||
-- the given declaration node. A list of aspects is built and stored for
|
-- flag is set in the given declaration node. A list of aspects
|
||||||
-- this declaration node using a call to Set_Aspect_Specifications. If
|
-- is built and stored for this declaration node using a call to
|
||||||
-- no WITH keyword is present, then this call has no effect other than
|
-- Set_Aspect_Specifications. If no WITH keyword is present, then this
|
||||||
-- scanning out the terminator if it is a semicolon.
|
-- call has no effect other than scanning out the terminator if it is a
|
||||||
|
-- semicolon (with the exception that it detects WHEN used in place of
|
||||||
|
-- WITH).
|
||||||
|
|
||||||
-- If Decl is Error on entry, any scanned aspect specifications are
|
-- If Decl is Error on entry, any scanned aspect specifications are
|
||||||
-- ignored and a message is output saying aspect specifications not
|
-- ignored and a message is output saying aspect specifications not
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- 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 --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -979,7 +979,7 @@ package body Rtsfind is
|
||||||
|
|
||||||
if U.Unum = No_Unit then
|
if U.Unum = No_Unit then
|
||||||
Load_Fail ("not found", U_Id, Id);
|
Load_Fail ("not found", U_Id, Id);
|
||||||
elsif Fatal_Error (U.Unum) then
|
elsif Fatal_Error (U.Unum) = Error_Detected then
|
||||||
Load_Fail ("had parser errors", U_Id, Id);
|
Load_Fail ("had parser errors", U_Id, Id);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -1025,7 +1025,7 @@ package body Rtsfind is
|
||||||
Semantics (Cunit (U.Unum));
|
Semantics (Cunit (U.Unum));
|
||||||
Restore_Private_Visibility;
|
Restore_Private_Visibility;
|
||||||
|
|
||||||
if Fatal_Error (U.Unum) then
|
if Fatal_Error (U.Unum) = Error_Detected then
|
||||||
Load_Fail ("had semantic errors", U_Id, Id);
|
Load_Fail ("had semantic errors", U_Id, Id);
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- 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 --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -936,7 +936,7 @@ package body Sem_Ch10 is
|
||||||
and then (Distribution_Stub_Mode = Generate_Receiver_Stub_Body
|
and then (Distribution_Stub_Mode = Generate_Receiver_Stub_Body
|
||||||
or else
|
or else
|
||||||
Distribution_Stub_Mode = Generate_Caller_Stub_Body)
|
Distribution_Stub_Mode = Generate_Caller_Stub_Body)
|
||||||
and then not Fatal_Error (Main_Unit)
|
and then Fatal_Error (Main_Unit) /= Error_Detected
|
||||||
then
|
then
|
||||||
if Is_RCI_Pkg_Spec_Or_Body (N) then
|
if Is_RCI_Pkg_Spec_Or_Body (N) then
|
||||||
|
|
||||||
|
@ -1096,7 +1096,7 @@ package body Sem_Ch10 is
|
||||||
|
|
||||||
elsif not Analyzed (Cunit (Un))
|
elsif not Analyzed (Cunit (Un))
|
||||||
and then Un /= Main_Unit
|
and then Un /= Main_Unit
|
||||||
and then not Fatal_Error (Un)
|
and then Fatal_Error (Un) /= Error_Detected
|
||||||
then
|
then
|
||||||
Style_Check := False;
|
Style_Check := False;
|
||||||
Semantics (Cunit (Un));
|
Semantics (Cunit (Un));
|
||||||
|
@ -1623,7 +1623,8 @@ package body Sem_Ch10 is
|
||||||
-- All done if we successfully loaded the subunit
|
-- All done if we successfully loaded the subunit
|
||||||
|
|
||||||
if Unum /= No_Unit
|
if Unum /= No_Unit
|
||||||
and then (not Fatal_Error (Unum) or else Try_Semantics)
|
and then (Fatal_Error (Unum) /= Error_Detected
|
||||||
|
or else Try_Semantics)
|
||||||
then
|
then
|
||||||
Comp_Unit := Cunit (Unum);
|
Comp_Unit := Cunit (Unum);
|
||||||
|
|
||||||
|
@ -1860,7 +1861,9 @@ package body Sem_Ch10 is
|
||||||
|
|
||||||
-- Analyze the unit if semantics active
|
-- Analyze the unit if semantics active
|
||||||
|
|
||||||
if not Fatal_Error (Unum) or else Try_Semantics then
|
if Fatal_Error (Unum) /= Error_Detected
|
||||||
|
or else Try_Semantics
|
||||||
|
then
|
||||||
Analyze_Subunit (Comp_Unit);
|
Analyze_Subunit (Comp_Unit);
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
@ -5442,7 +5445,7 @@ package body Sem_Ch10 is
|
||||||
else
|
else
|
||||||
Compiler_State := Analyzing; -- reset after load
|
Compiler_State := Analyzing; -- reset after load
|
||||||
|
|
||||||
if not Fatal_Error (Unum) or else Try_Semantics then
|
if Fatal_Error (Unum) /= Error_Detected or else Try_Semantics then
|
||||||
if Debug_Flag_L then
|
if Debug_Flag_L then
|
||||||
Write_Str ("*** Loaded generic body");
|
Write_Str ("*** Loaded generic body");
|
||||||
Write_Eol;
|
Write_Eol;
|
||||||
|
|
|
@ -7770,7 +7770,7 @@ package body Sem_Ch13 is
|
||||||
-- at the end of the private part and has the wrong visibility.
|
-- at the end of the private part and has the wrong visibility.
|
||||||
|
|
||||||
Set_Parent (Exp, N);
|
Set_Parent (Exp, N);
|
||||||
Preanalyze_Assert_Expression (Exp, Standard_Boolean);
|
Preanalyze_Assert_Expression (Exp, Any_Boolean);
|
||||||
|
|
||||||
-- A class-wide invariant may be inherited in a separate unit,
|
-- A class-wide invariant may be inherited in a separate unit,
|
||||||
-- where the corresponding expression cannot be resolved by
|
-- where the corresponding expression cannot be resolved by
|
||||||
|
|
|
@ -19420,15 +19420,27 @@ package body Sem_Ch3 is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Nkind (Parent (Priv_T)) = N_Private_Extension_Declaration
|
if Nkind (Parent (Priv_T)) = N_Private_Extension_Declaration
|
||||||
and then not Limited_Present (Parent (Priv_T))
|
|
||||||
and then not Synchronized_Present (Parent (Priv_T))
|
|
||||||
and then Nkind (Orig_Decl) = N_Full_Type_Declaration
|
and then Nkind (Orig_Decl) = N_Full_Type_Declaration
|
||||||
and then Nkind
|
and then Nkind
|
||||||
(Type_Definition (Orig_Decl)) = N_Derived_Type_Definition
|
(Type_Definition (Orig_Decl)) = N_Derived_Type_Definition
|
||||||
and then Limited_Present (Type_Definition (Orig_Decl))
|
|
||||||
then
|
then
|
||||||
Error_Msg_N
|
if not Limited_Present (Parent (Priv_T))
|
||||||
("full view of non-limited extension cannot be limited", N);
|
and then not Synchronized_Present (Parent (Priv_T))
|
||||||
|
and then Limited_Present (Type_Definition (Orig_Decl))
|
||||||
|
then
|
||||||
|
Error_Msg_N
|
||||||
|
("full view of non-limited extension cannot be limited", N);
|
||||||
|
|
||||||
|
-- Conversely, if the partial view carries the limited keyword,
|
||||||
|
-- the full view must as well, even if it may be redundant.
|
||||||
|
|
||||||
|
elsif Limited_Present (Parent (Priv_T))
|
||||||
|
and then not Limited_Present (Type_Definition (Orig_Decl))
|
||||||
|
then
|
||||||
|
Error_Msg_N
|
||||||
|
("full view of limited extension must be explicitly limited",
|
||||||
|
N);
|
||||||
|
end if;
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
|
@ -11783,7 +11783,7 @@ package body Sem_Prag is
|
||||||
Make_If_Statement (Eloc,
|
Make_If_Statement (Eloc,
|
||||||
Condition =>
|
Condition =>
|
||||||
Make_And_Then (Eloc,
|
Make_And_Then (Eloc,
|
||||||
Left_Opnd => New_Occurrence_Of (Standard_False, Eloc),
|
Left_Opnd => Make_Identifier (Eloc, Name_False),
|
||||||
Right_Opnd => Expr),
|
Right_Opnd => Expr),
|
||||||
Then_Statements => New_List (
|
Then_Statements => New_List (
|
||||||
Make_Null_Statement (Eloc))));
|
Make_Null_Statement (Eloc))));
|
||||||
|
|
|
@ -6310,11 +6310,14 @@ package body Sem_Res is
|
||||||
|
|
||||||
-- Check for calling a function with OUT or IN OUT parameter when the
|
-- Check for calling a function with OUT or IN OUT parameter when the
|
||||||
-- calling context (us right now) is not Ada 2012, so does not allow
|
-- calling context (us right now) is not Ada 2012, so does not allow
|
||||||
-- OUT or IN OUT parameters in function calls.
|
-- OUT or IN OUT parameters in function calls. Functions declared in
|
||||||
|
-- a predefined unit are OK, as they may be called indirectly from a
|
||||||
|
-- user-declared instantiation.
|
||||||
|
|
||||||
if Ada_Version < Ada_2012
|
if Ada_Version < Ada_2012
|
||||||
and then Ekind (Nam) = E_Function
|
and then Ekind (Nam) = E_Function
|
||||||
and then Has_Out_Or_In_Out_Parameter (Nam)
|
and then Has_Out_Or_In_Out_Parameter (Nam)
|
||||||
|
and then not In_Predefined_Unit (Nam)
|
||||||
then
|
then
|
||||||
Error_Msg_NE ("& has at least one OUT or `IN OUT` parameter", N, Nam);
|
Error_Msg_NE ("& has at least one OUT or `IN OUT` parameter", N, Nam);
|
||||||
Error_Msg_N ("\call to this function only allowed in Ada 2012", N);
|
Error_Msg_N ("\call to this function only allowed in Ada 2012", N);
|
||||||
|
|
Loading…
Reference in New Issue