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>
|
||||
|
||||
* g-rannum.adb, g-rannum.ads, s-rannum.adb, s-rannum.ads,
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
@ -5521,10 +5521,14 @@ package body Checks is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- Ditto if the prefix is an explicit dereference whose designated
|
||||
-- type is unconstrained.
|
||||
-- Ditto if prefix is simply an unconstrained array. We used
|
||||
-- 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)
|
||||
then
|
||||
Activate_Range_Check (N);
|
||||
|
|
|
@ -753,12 +753,23 @@ package body Errout is
|
|||
end if;
|
||||
|
||||
-- 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
|
||||
-- dealing with the configuration pragma file.
|
||||
|
||||
if not Try_Semantics and then Current_Source_Unit /= No_Unit then
|
||||
Set_Fatal_Error (Get_Source_Unit (Sptr));
|
||||
if Current_Source_Unit /= No_Unit then
|
||||
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 Handle_Serious_Error;
|
||||
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
@ -338,7 +338,7 @@ begin
|
|||
-- unit failed to load, to avoid cascaded inconsistencies that can lead
|
||||
-- to a compiler crash.
|
||||
|
||||
and then not Fatal_Error (Main_Unit)
|
||||
and then Fatal_Error (Main_Unit) /= Error_Detected
|
||||
then
|
||||
-- Pragmas that require some semantic activity, such as Interrupt_State,
|
||||
-- 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
|
||||
|
||||
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
|
||||
-- actually generate code for subunits, so we suppress expansion.
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
@ -212,7 +212,7 @@ package body Lib.Load is
|
|||
Dynamic_Elab => False,
|
||||
Error_Location => Sloc (With_Node),
|
||||
Expected_Unit => Spec_Name,
|
||||
Fatal_Error => True,
|
||||
Fatal_Error => Error_Detected,
|
||||
Generate_Code => False,
|
||||
Has_RACW => False,
|
||||
Filler => False,
|
||||
|
@ -319,7 +319,7 @@ package body Lib.Load is
|
|||
Dynamic_Elab => False,
|
||||
Error_Location => No_Location,
|
||||
Expected_Unit => No_Unit_Name,
|
||||
Fatal_Error => False,
|
||||
Fatal_Error => None,
|
||||
Generate_Code => False,
|
||||
Has_RACW => False,
|
||||
Filler => False,
|
||||
|
@ -683,7 +683,7 @@ package body Lib.Load is
|
|||
Dynamic_Elab => False,
|
||||
Error_Location => Sloc (Error_Node),
|
||||
Expected_Unit => Uname_Actual,
|
||||
Fatal_Error => False,
|
||||
Fatal_Error => None,
|
||||
Generate_Code => False,
|
||||
Has_RACW => False,
|
||||
Filler => False,
|
||||
|
@ -742,10 +742,20 @@ package body Lib.Load is
|
|||
|
||||
-- If loaded unit had a fatal error, then caller inherits it
|
||||
|
||||
if Units.Table (Unum).Fatal_Error
|
||||
and then Present (Error_Node)
|
||||
then
|
||||
Units.Table (Calling_Unit).Fatal_Error := True;
|
||||
if Present (Error_Node) then
|
||||
case Units.Table (Unum).Fatal_Error is
|
||||
when None =>
|
||||
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;
|
||||
|
||||
-- Remove load stack entry and return the entry in the file table
|
||||
|
|
|
@ -81,7 +81,7 @@ package body Lib.Writ is
|
|||
Cunit_Entity => Empty,
|
||||
Dependency_Num => 0,
|
||||
Dynamic_Elab => False,
|
||||
Fatal_Error => False,
|
||||
Fatal_Error => None,
|
||||
Generate_Code => False,
|
||||
Has_RACW => False,
|
||||
Filler => False,
|
||||
|
@ -139,7 +139,7 @@ package body Lib.Writ is
|
|||
Cunit_Entity => Empty,
|
||||
Dependency_Num => 0,
|
||||
Dynamic_Elab => False,
|
||||
Fatal_Error => False,
|
||||
Fatal_Error => None,
|
||||
Generate_Code => False,
|
||||
Has_RACW => False,
|
||||
Filler => False,
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
@ -106,7 +106,7 @@ package body Lib is
|
|||
return Units.Table (U).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
|
||||
return Units.Table (U).Fatal_Error;
|
||||
end Fatal_Error;
|
||||
|
@ -196,9 +196,9 @@ package body Lib is
|
|||
Units.Table (U).Error_Location := W;
|
||||
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
|
||||
Units.Table (U).Fatal_Error := B;
|
||||
Units.Table (U).Fatal_Error := V;
|
||||
end Set_Fatal_Error;
|
||||
|
||||
procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True) is
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
@ -302,7 +302,7 @@ package Lib is
|
|||
-- No_Name for the main unit.
|
||||
|
||||
-- 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
|
||||
-- defined as serious enough to stop the next phase of the compiler
|
||||
-- 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
|
||||
-- eventually perhaps only errors labeled as fatal errors should be
|
||||
-- this severe if we decide to try Sem on sources with minor errors.
|
||||
-- There are three settings (see declaration of Fatal_Type).
|
||||
|
||||
-- Generate_Code
|
||||
-- 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;
|
||||
-- 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_Entity (U : Unit_Number_Type) return Entity_Id;
|
||||
function Dependency_Num (U : Unit_Number_Type) return Nat;
|
||||
function Dynamic_Elab (U : Unit_Number_Type) return Boolean;
|
||||
function Error_Location (U : Unit_Number_Type) return Source_Ptr;
|
||||
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 Ident_String (U : Unit_Number_Type) return Node_Id;
|
||||
function Has_RACW (U : Unit_Number_Type) return Boolean;
|
||||
|
@ -426,7 +443,7 @@ package Lib is
|
|||
procedure Set_Cunit_Entity (U : Unit_Number_Type; E : Entity_Id);
|
||||
procedure Set_Dynamic_Elab (U : Unit_Number_Type; B : Boolean := True);
|
||||
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_Has_RACW (U : Unit_Number_Type; B : Boolean := True);
|
||||
procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id);
|
||||
|
@ -606,7 +623,7 @@ package Lib is
|
|||
function Is_Loaded (Uname : Unit_Name_Type) return Boolean;
|
||||
-- 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
|
||||
-- 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.
|
||||
|
||||
function Last_Unit return Unit_Number_Type;
|
||||
|
@ -767,7 +784,7 @@ private
|
|||
Serial_Number : Nat;
|
||||
Version : Word;
|
||||
Error_Location : Source_Ptr;
|
||||
Fatal_Error : Boolean;
|
||||
Fatal_Error : Fatal_Type;
|
||||
Generate_Code : Boolean;
|
||||
Has_RACW : Boolean;
|
||||
Dynamic_Elab : Boolean;
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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 --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
|
@ -596,7 +596,7 @@ package body Ch10 is
|
|||
|
||||
else
|
||||
Cunit_Error_Flag := True;
|
||||
Set_Fatal_Error (Current_Source_Unit);
|
||||
Set_Fatal_Error (Current_Source_Unit, Error_Detected);
|
||||
end if;
|
||||
|
||||
-- Clear away any missing semicolon indication, we are done with that
|
||||
|
@ -726,7 +726,7 @@ package body Ch10 is
|
|||
-- cascaded messages in some situations.
|
||||
|
||||
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
|
||||
Error_Msg_SC
|
||||
("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
|
||||
|
||||
when Error_Resync =>
|
||||
Set_Fatal_Error (Current_Source_Unit);
|
||||
Set_Fatal_Error (Current_Source_Unit, Error_Detected);
|
||||
return Error;
|
||||
end P_Compilation_Unit;
|
||||
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
@ -48,6 +48,10 @@ package body Ch13 is
|
|||
function Possible_Misspelled_Aspect return Boolean;
|
||||
-- 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 --
|
||||
--------------------------------
|
||||
|
@ -63,6 +67,43 @@ package body Ch13 is
|
|||
return False;
|
||||
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
|
||||
|
||||
begin
|
||||
|
@ -79,14 +120,15 @@ package body Ch13 is
|
|||
-- be too expensive. Instead we pick up the aspect specifications later
|
||||
-- as a bogus declaration, and diagnose the semicolon at that point.
|
||||
|
||||
if Token /= Tok_With then
|
||||
if not With_Present then
|
||||
return False;
|
||||
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);
|
||||
Scan; -- past WITH
|
||||
Scan; -- past WITH (or WHEN or other bad keyword)
|
||||
|
||||
-- If no identifier, then consider that we definitely do not have an
|
||||
-- aspect specification.
|
||||
|
@ -193,7 +235,7 @@ package body Ch13 is
|
|||
return Aspects;
|
||||
end if;
|
||||
|
||||
Scan; -- past WITH
|
||||
Scan; -- past WITH (or possible WHEN after error)
|
||||
Aspects := Empty_List;
|
||||
|
||||
-- Loop to scan aspects
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
@ -127,7 +127,7 @@ procedure Load is
|
|||
begin
|
||||
-- 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;
|
||||
end if;
|
||||
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
@ -951,6 +951,9 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
|
|||
-- permitted). Note: this routine never checks the terminator token
|
||||
-- for aspects so it does not matter whether the aspect specifications
|
||||
-- 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
|
||||
(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
|
||||
-- and the caller must check for a proper terminator.
|
||||
--
|
||||
-- P_Aspect_Specifications is called with the current token pointing to
|
||||
-- either a WITH keyword starting an aspect specification, or an
|
||||
-- instance of the terminator token. In the former case, the aspect
|
||||
-- specifications are scanned out including the terminator token if it
|
||||
-- it is a semicolon, and the Has_Aspect_Specifications flag is set in
|
||||
-- the given declaration node. A list of aspects is built and stored for
|
||||
-- this declaration node using a call to Set_Aspect_Specifications. If
|
||||
-- no WITH keyword is present, then this call has no effect other than
|
||||
-- scanning out the terminator if it is a semicolon.
|
||||
-- P_Aspect_Specifications is called with the current token pointing
|
||||
-- to either a WITH keyword starting an aspect specification, or an
|
||||
-- instance of what shpould be a terminator token. In the former case,
|
||||
-- the aspect specifications are scanned out including the terminator
|
||||
-- token if it it is a semicolon, and the Has_Aspect_Specifications
|
||||
-- flag is set in the given declaration node. A list of aspects
|
||||
-- is built and stored for this declaration node using a call to
|
||||
-- Set_Aspect_Specifications. If no WITH keyword is present, then this
|
||||
-- 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
|
||||
-- ignored and a message is output saying aspect specifications not
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
@ -979,7 +979,7 @@ package body Rtsfind is
|
|||
|
||||
if U.Unum = No_Unit then
|
||||
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);
|
||||
end if;
|
||||
|
||||
|
@ -1025,7 +1025,7 @@ package body Rtsfind is
|
|||
Semantics (Cunit (U.Unum));
|
||||
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);
|
||||
end if;
|
||||
end if;
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
@ -936,7 +936,7 @@ package body Sem_Ch10 is
|
|||
and then (Distribution_Stub_Mode = Generate_Receiver_Stub_Body
|
||||
or else
|
||||
Distribution_Stub_Mode = Generate_Caller_Stub_Body)
|
||||
and then not Fatal_Error (Main_Unit)
|
||||
and then Fatal_Error (Main_Unit) /= Error_Detected
|
||||
then
|
||||
if Is_RCI_Pkg_Spec_Or_Body (N) then
|
||||
|
||||
|
@ -1096,7 +1096,7 @@ package body Sem_Ch10 is
|
|||
|
||||
elsif not Analyzed (Cunit (Un))
|
||||
and then Un /= Main_Unit
|
||||
and then not Fatal_Error (Un)
|
||||
and then Fatal_Error (Un) /= Error_Detected
|
||||
then
|
||||
Style_Check := False;
|
||||
Semantics (Cunit (Un));
|
||||
|
@ -1623,7 +1623,8 @@ package body Sem_Ch10 is
|
|||
-- All done if we successfully loaded the subunit
|
||||
|
||||
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
|
||||
Comp_Unit := Cunit (Unum);
|
||||
|
||||
|
@ -1860,7 +1861,9 @@ package body Sem_Ch10 is
|
|||
|
||||
-- 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);
|
||||
end if;
|
||||
end if;
|
||||
|
@ -5442,7 +5445,7 @@ package body Sem_Ch10 is
|
|||
else
|
||||
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
|
||||
Write_Str ("*** Loaded generic body");
|
||||
Write_Eol;
|
||||
|
|
|
@ -7770,7 +7770,7 @@ package body Sem_Ch13 is
|
|||
-- at the end of the private part and has the wrong visibility.
|
||||
|
||||
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,
|
||||
-- where the corresponding expression cannot be resolved by
|
||||
|
|
|
@ -19420,15 +19420,27 @@ package body Sem_Ch3 is
|
|||
|
||||
begin
|
||||
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
|
||||
(Type_Definition (Orig_Decl)) = N_Derived_Type_Definition
|
||||
then
|
||||
if not Limited_Present (Parent (Priv_T))
|
||||
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;
|
||||
|
||||
|
|
|
@ -11783,7 +11783,7 @@ package body Sem_Prag is
|
|||
Make_If_Statement (Eloc,
|
||||
Condition =>
|
||||
Make_And_Then (Eloc,
|
||||
Left_Opnd => New_Occurrence_Of (Standard_False, Eloc),
|
||||
Left_Opnd => Make_Identifier (Eloc, Name_False),
|
||||
Right_Opnd => Expr),
|
||||
Then_Statements => New_List (
|
||||
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
|
||||
-- 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
|
||||
and then Ekind (Nam) = E_Function
|
||||
and then Has_Out_Or_In_Out_Parameter (Nam)
|
||||
and then not In_Predefined_Unit (Nam)
|
||||
then
|
||||
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);
|
||||
|
|
Loading…
Reference in New Issue