[multiple changes]
2014-10-23 Ed Schonberg <schonberg@adacore.com> * sem_ch6.adb (Analyze_Expression_Function): Simplify analysis in generic context, and generate body in this case as well, to simplify ASIS traversals on the construct. 2014-10-23 Ed Schonberg <schonberg@adacore.com> * sem_ch4.adb (Complete_Object_Operation): Indicate that the scope of the operation (s) is referenced, to prevent spurious warnings about unused units. 2014-10-23 Johannes Kanig <kanig@adacore.com> * errout.adb (Error_Msg_Internal): Copy check flag, increment check msg count. * erroutc.adb (Delete_Msg) adjust check msg count. (Output_Msg_Text) handle check msg case (do nothing). (Prescan_Message) recognize check messages with severity prefixes. * errutil.adb (Error_Msg) handle check flag, adjust counter. 2014-10-23 Ed Schonberg <schonberg@adacore.com> * sem_eval.adb (Subtypes_Statically_Match): For a generic actual type, check for the presence of discriminants in its parent type, against the presence of discriminants in the context type. 2014-10-23 Tristan Gingold <gingold@adacore.com> * adaint.c: __gnat_get_file_names_case_sensitive: Default is true on arm-darwin. 2014-10-23 Arnaud Charlet <charlet@adacore.com> * pprint.adb (Expression_Image): Add handling of quantifiers. 2014-10-23 Ed Schonberg <schonberg@adacore.com> * exp_pakd.adb (Expand_Packed_Element_Reference): If the prefix is a source entity, generate a reference to it before transformation, because rewritten node might not generate a proper reference, leading to spurious warnings. 2014-10-23 Tristan Gingold <gingold@adacore.com> * init.c: Fix thinko in previous patch. 2014-10-23 Hristian Kirtchev <kirtchev@adacore.com> * sem_ch3.adb (Decimal_Fixed_Point_Type_Declaration): Inherit the rep chain of the implicit base type. (Floating_Point_Type_Declaration): Inherit the rep chain of the implicit base type. (Ordinary_Fixed_Point_Type_Declaration): Inherit the rep chain of the implicit base type. (Signed_Integer_Type_Declaration): Inherit the rep chain of the implicit base type. * sem_util.ads, sem_util.adb (Inherit_Rep_Item_Chain): New routine. 2014-10-23 Pascal Obry <obry@adacore.com> * g-regist.adb, g-regist.ads: Add support for reading 32bit or 64bit view of the registry. 2014-10-23 Ed Schonberg <schonberg@adacore.com> * exp_ch3.adb (Expand_N_Object_Declaration): If type is abstract, return without expanding expression, to prevent subsequent crash. * freeze.adb: better error message for illegal declaration. From-SVN: r216587
This commit is contained in:
parent
e776d44161
commit
e699b76e92
|
@ -1,3 +1,73 @@
|
|||
2014-10-23 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch6.adb (Analyze_Expression_Function): Simplify analysis
|
||||
in generic context, and generate body in this case as well,
|
||||
to simplify ASIS traversals on the construct.
|
||||
|
||||
2014-10-23 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch4.adb (Complete_Object_Operation): Indicate that the
|
||||
scope of the operation (s) is referenced, to prevent spurious
|
||||
warnings about unused units.
|
||||
|
||||
2014-10-23 Johannes Kanig <kanig@adacore.com>
|
||||
|
||||
* errout.adb (Error_Msg_Internal): Copy check flag, increment
|
||||
check msg count.
|
||||
* erroutc.adb (Delete_Msg) adjust check msg count.
|
||||
(Output_Msg_Text) handle check msg case (do nothing).
|
||||
(Prescan_Message) recognize check messages with severity prefixes.
|
||||
* errutil.adb (Error_Msg) handle check flag, adjust counter.
|
||||
|
||||
2014-10-23 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_eval.adb (Subtypes_Statically_Match): For a generic actual
|
||||
type, check for the presence of discriminants in its parent type,
|
||||
against the presence of discriminants in the context type.
|
||||
|
||||
2014-10-23 Tristan Gingold <gingold@adacore.com>
|
||||
|
||||
* adaint.c: __gnat_get_file_names_case_sensitive: Default is
|
||||
true on arm-darwin.
|
||||
|
||||
2014-10-23 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* pprint.adb (Expression_Image): Add handling of quantifiers.
|
||||
|
||||
2014-10-23 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_pakd.adb (Expand_Packed_Element_Reference): If the
|
||||
prefix is a source entity, generate a reference to it before
|
||||
transformation, because rewritten node might not generate a
|
||||
proper reference, leading to spurious warnings.
|
||||
|
||||
2014-10-23 Tristan Gingold <gingold@adacore.com>
|
||||
|
||||
* init.c: Fix thinko in previous patch.
|
||||
|
||||
2014-10-23 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Decimal_Fixed_Point_Type_Declaration):
|
||||
Inherit the rep chain of the implicit base type.
|
||||
(Floating_Point_Type_Declaration): Inherit the rep chain of the
|
||||
implicit base type.
|
||||
(Ordinary_Fixed_Point_Type_Declaration): Inherit the rep chain of the
|
||||
implicit base type.
|
||||
(Signed_Integer_Type_Declaration): Inherit the rep chain of the
|
||||
implicit base type.
|
||||
* sem_util.ads, sem_util.adb (Inherit_Rep_Item_Chain): New routine.
|
||||
|
||||
2014-10-23 Pascal Obry <obry@adacore.com>
|
||||
|
||||
* g-regist.adb, g-regist.ads: Add support for reading 32bit or 64bit
|
||||
view of the registry.
|
||||
|
||||
2014-10-23 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_ch3.adb (Expand_N_Object_Declaration): If type is abstract,
|
||||
return without expanding expression, to prevent subsequent crash.
|
||||
* freeze.adb: better error message for illegal declaration.
|
||||
|
||||
2014-10-23 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* sysdep.c (__gnat_localtime_tzoff): Properly delimit the
|
||||
|
|
|
@ -547,11 +547,15 @@ __gnat_get_file_names_case_sensitive (void)
|
|||
&& sensitive[1] == '\0')
|
||||
file_names_case_sensitive_cache = sensitive[0] - '0';
|
||||
else
|
||||
#if defined (WINNT) || defined (__APPLE__)
|
||||
file_names_case_sensitive_cache = 0;
|
||||
{
|
||||
/* By default, we suppose filesystems aren't case sensitive on
|
||||
Windows and Darwin (but they are on arm-darwin). */
|
||||
#if defined (WINNT) || (defined (__APPLE__) && !defined (__arm__))
|
||||
file_names_case_sensitive_cache = 0;
|
||||
#else
|
||||
file_names_case_sensitive_cache = 1;
|
||||
file_names_case_sensitive_cache = 1;
|
||||
#endif
|
||||
}
|
||||
}
|
||||
return file_names_case_sensitive_cache;
|
||||
}
|
||||
|
|
|
@ -320,6 +320,10 @@ package Atree is
|
|||
-- Number of info messages generated. Info messages are neved treated as
|
||||
-- errors (whether from use of the pragma, or the compiler switch -gnatwe).
|
||||
|
||||
Check_Messages : Nat := 0;
|
||||
-- Number of check messages generated. Check messages are neither warnings
|
||||
-- nor errors.
|
||||
|
||||
Warnings_Treated_As_Errors : Nat := 0;
|
||||
-- Number of warnings changed into errors as a result of matching a pattern
|
||||
-- given in a Warning_As_Error configuration pragma.
|
||||
|
|
|
@ -982,6 +982,7 @@ package body Errout is
|
|||
Col => Get_Column_Number (Sptr),
|
||||
Warn => Is_Warning_Msg,
|
||||
Info => Is_Info_Msg,
|
||||
Check => Is_Check_Msg,
|
||||
Warn_Err => False, -- reset below
|
||||
Warn_Chr => Warning_Msg_Char,
|
||||
Style => Is_Style_Msg,
|
||||
|
@ -1140,6 +1141,9 @@ package body Errout is
|
|||
Info_Messages := Info_Messages + 1;
|
||||
end if;
|
||||
|
||||
elsif Errors.Table (Cur_Msg).Check then
|
||||
Check_Messages := Check_Messages + 1;
|
||||
|
||||
else
|
||||
Total_Errors_Detected := Total_Errors_Detected + 1;
|
||||
|
||||
|
|
|
@ -413,6 +413,13 @@ package Errout is
|
|||
-- are continuations that are not printed using the -gnatj switch they
|
||||
-- will also have this prefix.
|
||||
|
||||
-- Insertion sequence "low: " or "medium: " or "high: " (check message)
|
||||
-- This appears only at the start of the message (and not any of its
|
||||
-- continuations, if any), and indicates that the message is a check
|
||||
-- message. The message will be output with this prefix. Check
|
||||
-- messages are not fatal (so are like info messages in that respect)
|
||||
-- and are not controlled by pragma Warnings.
|
||||
|
||||
-----------------------------------------------------
|
||||
-- Global Values Used for Error Message Insertions --
|
||||
-----------------------------------------------------
|
||||
|
|
|
@ -145,6 +145,9 @@ package body Erroutc is
|
|||
-- because this only gets incremented if we actually output the
|
||||
-- message, which we won't do if we are deleting it here!
|
||||
|
||||
elsif Errors.Table (D).Check then
|
||||
Check_Messages := Check_Messages - 1;
|
||||
|
||||
else
|
||||
Total_Errors_Detected := Total_Errors_Detected - 1;
|
||||
|
||||
|
@ -653,6 +656,11 @@ package body Erroutc is
|
|||
elsif Errors.Table (E).Style then
|
||||
null;
|
||||
|
||||
-- No prefix needed for check message, severity is there already
|
||||
|
||||
elsif Errors.Table (E).Check then
|
||||
null;
|
||||
|
||||
-- All other cases, add "error: " if unique error tag set
|
||||
|
||||
elsif Opt.Unique_Error_Tag then
|
||||
|
@ -765,6 +773,15 @@ package body Erroutc is
|
|||
Is_Info_Msg :=
|
||||
Msg'Length > 6 and then Msg (Msg'First .. Msg'First + 5) = "info: ";
|
||||
|
||||
-- Check check message
|
||||
|
||||
Is_Check_Msg :=
|
||||
(Msg'Length > 8 and then Msg (Msg'First .. Msg'First + 7) = "medium: ")
|
||||
or else
|
||||
(Msg'Length > 6 and then Msg (Msg'First .. Msg'First + 5) = "high: ")
|
||||
or else
|
||||
(Msg'Length > 5 and then Msg (Msg'First .. Msg'First + 4) = "low: ");
|
||||
|
||||
-- Loop through message looking for relevant insertion sequences
|
||||
|
||||
J := Msg'First;
|
||||
|
@ -833,7 +850,7 @@ package body Erroutc is
|
|||
end if;
|
||||
end loop;
|
||||
|
||||
if Is_Warning_Msg or Is_Style_Msg then
|
||||
if Is_Warning_Msg or Is_Style_Msg or Is_Check_Msg then
|
||||
Is_Serious_Error := False;
|
||||
end if;
|
||||
end Prescan_Message;
|
||||
|
|
|
@ -68,6 +68,10 @@ package Erroutc is
|
|||
-- "info: " and is to be treated as an information message. This string
|
||||
-- will be prepended to the message and all its continuations.
|
||||
|
||||
Is_Check_Msg : Boolean := False;
|
||||
-- Set True to indicate that the current message starts with one of
|
||||
-- "high: ", "medium: ", "low: " and is to be treated as a check message.
|
||||
|
||||
Warning_Msg_Char : Character;
|
||||
-- Warning character, valid only if Is_Warning_Msg is True
|
||||
-- ' ' -- ? or < appeared on its own in message
|
||||
|
@ -208,6 +212,9 @@ package Erroutc is
|
|||
Info : Boolean;
|
||||
-- True if info message
|
||||
|
||||
Check : Boolean;
|
||||
-- True if check message
|
||||
|
||||
Warn_Err : Boolean;
|
||||
-- True if this is a warning message which is to be treated as an error
|
||||
-- as a result of a match with a Warning_As_Error pragma.
|
||||
|
|
|
@ -213,6 +213,7 @@ package body Errutil is
|
|||
Col => Get_Column_Number (Sptr),
|
||||
Warn => Is_Warning_Msg,
|
||||
Info => Is_Info_Msg,
|
||||
Check => Is_Check_Msg,
|
||||
Warn_Err => Warning_Mode = Treat_As_Error,
|
||||
Warn_Chr => Warning_Msg_Char,
|
||||
Style => Is_Style_Msg,
|
||||
|
@ -313,6 +314,9 @@ package body Errutil is
|
|||
Info_Messages := Info_Messages + 1;
|
||||
end if;
|
||||
|
||||
elsif Errors.Table (Cur_Msg).Check then
|
||||
Check_Messages := Check_Messages + 1;
|
||||
|
||||
else
|
||||
Total_Errors_Detected := Total_Errors_Detected + 1;
|
||||
|
||||
|
|
|
@ -5346,6 +5346,14 @@ package body Exp_Ch3 is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- The type of the object cannot be abstract. This is diagnosed at the
|
||||
-- point the object is frozen, which happens after the declaration is
|
||||
-- fully expanded, so simply return now.
|
||||
|
||||
if Is_Abstract_Type (Typ) then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- First we do special processing for objects of a tagged type where
|
||||
-- this is the point at which the type is frozen. The creation of the
|
||||
-- dispatch table and the initialization procedure have to be deferred
|
||||
|
|
|
@ -30,6 +30,7 @@ with Errout; use Errout;
|
|||
with Exp_Dbug; use Exp_Dbug;
|
||||
with Exp_Util; use Exp_Util;
|
||||
with Layout; use Layout;
|
||||
with Lib.Xref; use Lib.Xref;
|
||||
with Namet; use Namet;
|
||||
with Nlists; use Nlists;
|
||||
with Nmake; use Nmake;
|
||||
|
@ -1682,6 +1683,16 @@ package body Exp_Pakd is
|
|||
Expand_Packed_Element_Reference (Prefix (N));
|
||||
end if;
|
||||
|
||||
-- The prefix may be rewritten below as a conversion. If it is a source
|
||||
-- entity generate reference to it now, to prevent spurious warnings
|
||||
-- about unused entities.
|
||||
|
||||
if Is_Entity_Name (Prefix (N))
|
||||
and then Comes_From_Source (Prefix (N))
|
||||
then
|
||||
Generate_Reference (Entity (Prefix (N)), Prefix (N), 'r');
|
||||
end if;
|
||||
|
||||
-- If not bit packed, we have the enumeration case, which is easily
|
||||
-- dealt with (just adjust the subscripts of the indexed component)
|
||||
|
||||
|
|
|
@ -4498,6 +4498,11 @@ package body Freeze is
|
|||
Error_Msg_NE
|
||||
("\} may need a cpp_constructor",
|
||||
Object_Definition (Parent (E)), Etype (E));
|
||||
|
||||
elsif Present (Expression (Parent (E))) then
|
||||
Error_Msg_N -- CODEFIX
|
||||
("\maybe a class-wide type was meant",
|
||||
Object_Definition (Parent (E)));
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2001-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- --
|
||||
|
@ -529,16 +529,24 @@ package body GNAT.Registry is
|
|||
function To_C_Mode (Mode : Key_Mode) return REGSAM is
|
||||
use type REGSAM;
|
||||
|
||||
KEY_READ : constant := 16#20019#;
|
||||
KEY_WRITE : constant := 16#20006#;
|
||||
KEY_READ : constant := 16#20019#;
|
||||
KEY_WRITE : constant := 16#20006#;
|
||||
KEY_WOW64_64KEY : constant := 16#00100#;
|
||||
KEY_WOW64_32KEY : constant := 16#00200#;
|
||||
|
||||
begin
|
||||
case Mode is
|
||||
when Read_Only =>
|
||||
return KEY_READ;
|
||||
return KEY_READ + KEY_WOW64_32KEY;
|
||||
|
||||
when Read_Write =>
|
||||
return KEY_READ + KEY_WRITE;
|
||||
return KEY_READ + KEY_WRITE + KEY_WOW64_32KEY;
|
||||
|
||||
when Read_Only_64 =>
|
||||
return KEY_READ + KEY_WOW64_64KEY;
|
||||
|
||||
when Read_Write_64 =>
|
||||
return KEY_READ + KEY_WRITE + KEY_WOW64_64KEY;
|
||||
end case;
|
||||
end To_C_Mode;
|
||||
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2001-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- --
|
||||
|
@ -54,8 +54,12 @@ package GNAT.Registry is
|
|||
HKEY_USERS : constant HKEY;
|
||||
HKEY_PERFORMANCE_DATA : constant HKEY;
|
||||
|
||||
type Key_Mode is (Read_Only, Read_Write);
|
||||
-- Access mode for the registry key
|
||||
type Key_Mode is
|
||||
(Read_Only, Read_Write, -- operates on 32bit view of the registry
|
||||
Read_Only_64, Read_Write_64); -- operates on 64bit view of the registry
|
||||
-- Access mode for the registry key. The *_64 are only meaningful on
|
||||
-- Windows 64bit and ignored on Windows 32bit where _64 are equivalent to
|
||||
-- the non 64bit versions.
|
||||
|
||||
Registry_Error : exception;
|
||||
-- Registry_Error is raises by all routines below if a problem occurs
|
||||
|
|
|
@ -2238,7 +2238,7 @@ __gnat_is_stack_guard (mach_vm_address_t addr)
|
|||
return 0;
|
||||
#else
|
||||
/* Pagezero for arm. */
|
||||
return addr < 4096;
|
||||
return addr >= 4096;
|
||||
#endif
|
||||
}
|
||||
|
||||
|
|
|
@ -623,6 +623,9 @@ package body Pprint is
|
|||
exit;
|
||||
end if;
|
||||
|
||||
when N_Quantified_Expression =>
|
||||
Right := Original_Node (Condition (Right));
|
||||
|
||||
-- For all other items, quit the loop
|
||||
|
||||
when others =>
|
||||
|
|
|
@ -13914,17 +13914,19 @@ package body Sem_Ch3 is
|
|||
Set_Fixed_Range (T, Loc, -Bound_Val, Bound_Val);
|
||||
end if;
|
||||
|
||||
-- Complete entity for first subtype
|
||||
-- Complete entity for first subtype. The inheritance of the rep item
|
||||
-- chain ensures that SPARK-related pragmas are not clobbered when the
|
||||
-- decimal fixed point type acts as a full view of a private type.
|
||||
|
||||
Set_Ekind (T, E_Decimal_Fixed_Point_Subtype);
|
||||
Set_Etype (T, Implicit_Base);
|
||||
Set_Size_Info (T, Implicit_Base);
|
||||
Set_First_Rep_Item (T, First_Rep_Item (Implicit_Base));
|
||||
Set_Digits_Value (T, Digs_Val);
|
||||
Set_Delta_Value (T, Delta_Val);
|
||||
Set_Small_Value (T, Delta_Val);
|
||||
Set_Scale_Value (T, Scale_Val);
|
||||
Set_Is_Constrained (T);
|
||||
Set_Ekind (T, E_Decimal_Fixed_Point_Subtype);
|
||||
Set_Etype (T, Implicit_Base);
|
||||
Set_Size_Info (T, Implicit_Base);
|
||||
Inherit_Rep_Item_Chain (T, Implicit_Base);
|
||||
Set_Digits_Value (T, Digs_Val);
|
||||
Set_Delta_Value (T, Delta_Val);
|
||||
Set_Small_Value (T, Delta_Val);
|
||||
Set_Scale_Value (T, Scale_Val);
|
||||
Set_Is_Constrained (T);
|
||||
end Decimal_Fixed_Point_Type_Declaration;
|
||||
|
||||
-----------------------------------
|
||||
|
@ -16725,24 +16727,25 @@ package body Sem_Ch3 is
|
|||
Set_Scalar_Range (T, Scalar_Range (Base_Typ));
|
||||
end if;
|
||||
|
||||
-- Complete definition of implicit base and declared first subtype
|
||||
-- Complete definition of implicit base and declared first subtype. The
|
||||
-- inheritance of the rep item chain ensures that SPARK-related pragmas
|
||||
-- are not clobbered when the floating point type acts as a full view of
|
||||
-- a private type.
|
||||
|
||||
Set_Etype (Implicit_Base, Base_Typ);
|
||||
Set_Etype (Implicit_Base, Base_Typ);
|
||||
Set_Scalar_Range (Implicit_Base, Scalar_Range (Base_Typ));
|
||||
Set_Size_Info (Implicit_Base, Base_Typ);
|
||||
Set_RM_Size (Implicit_Base, RM_Size (Base_Typ));
|
||||
Set_First_Rep_Item (Implicit_Base, First_Rep_Item (Base_Typ));
|
||||
Set_Digits_Value (Implicit_Base, Digits_Value (Base_Typ));
|
||||
Set_Float_Rep (Implicit_Base, Float_Rep (Base_Typ));
|
||||
|
||||
Set_Scalar_Range (Implicit_Base, Scalar_Range (Base_Typ));
|
||||
Set_Size_Info (Implicit_Base, (Base_Typ));
|
||||
Set_RM_Size (Implicit_Base, RM_Size (Base_Typ));
|
||||
Set_First_Rep_Item (Implicit_Base, First_Rep_Item (Base_Typ));
|
||||
Set_Digits_Value (Implicit_Base, Digits_Value (Base_Typ));
|
||||
Set_Float_Rep (Implicit_Base, Float_Rep (Base_Typ));
|
||||
|
||||
Set_Ekind (T, E_Floating_Point_Subtype);
|
||||
Set_Etype (T, Implicit_Base);
|
||||
|
||||
Set_Size_Info (T, (Implicit_Base));
|
||||
Set_RM_Size (T, RM_Size (Implicit_Base));
|
||||
Set_First_Rep_Item (T, First_Rep_Item (Implicit_Base));
|
||||
Set_Digits_Value (T, Digs_Val);
|
||||
Set_Ekind (T, E_Floating_Point_Subtype);
|
||||
Set_Etype (T, Implicit_Base);
|
||||
Set_Size_Info (T, Implicit_Base);
|
||||
Set_RM_Size (T, RM_Size (Implicit_Base));
|
||||
Inherit_Rep_Item_Chain (T, Implicit_Base);
|
||||
Set_Digits_Value (T, Digs_Val);
|
||||
end Floating_Point_Type_Declaration;
|
||||
|
||||
----------------------------
|
||||
|
@ -18436,15 +18439,17 @@ package body Sem_Ch3 is
|
|||
Set_Fixed_Range (Implicit_Base, Loc, Low_Val, High_Val);
|
||||
Set_Fixed_Range (T, Loc, Low_Val, High_Val);
|
||||
|
||||
-- Complete definition of first subtype
|
||||
-- Complete definition of first subtype. The inheritance of the rep item
|
||||
-- chain ensures that SPARK-related pragmas are not clobbered when the
|
||||
-- ordinary fixed point type acts as a full view of a private type.
|
||||
|
||||
Set_Ekind (T, E_Ordinary_Fixed_Point_Subtype);
|
||||
Set_Etype (T, Implicit_Base);
|
||||
Init_Size_Align (T);
|
||||
Set_First_Rep_Item (T, First_Rep_Item (Implicit_Base));
|
||||
Set_Small_Value (T, Small_Val);
|
||||
Set_Delta_Value (T, Delta_Val);
|
||||
Set_Is_Constrained (T);
|
||||
Set_Ekind (T, E_Ordinary_Fixed_Point_Subtype);
|
||||
Set_Etype (T, Implicit_Base);
|
||||
Init_Size_Align (T);
|
||||
Inherit_Rep_Item_Chain (T, Implicit_Base);
|
||||
Set_Small_Value (T, Small_Val);
|
||||
Set_Delta_Value (T, Delta_Val);
|
||||
Set_Is_Constrained (T);
|
||||
end Ordinary_Fixed_Point_Type_Declaration;
|
||||
|
||||
----------------------------------
|
||||
|
@ -19090,7 +19095,6 @@ package body Sem_Ch3 is
|
|||
-- ELSE.
|
||||
|
||||
else
|
||||
|
||||
-- In formal mode, when completing a private extension the type
|
||||
-- named in the private part must be exactly the same as that
|
||||
-- named in the visible part.
|
||||
|
@ -21215,23 +21219,24 @@ package body Sem_Ch3 is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
-- Complete both implicit base and declared first subtype entities
|
||||
-- Complete both implicit base and declared first subtype entities. The
|
||||
-- inheritance of the rep item chain ensures that SPARK-related pragmas
|
||||
-- are not clobbered when the signed integer type acts as a full view of
|
||||
-- a private type.
|
||||
|
||||
Set_Etype (Implicit_Base, Base_Typ);
|
||||
Set_Size_Info (Implicit_Base, (Base_Typ));
|
||||
Set_Size_Info (Implicit_Base, Base_Typ);
|
||||
Set_RM_Size (Implicit_Base, RM_Size (Base_Typ));
|
||||
Set_First_Rep_Item (Implicit_Base, First_Rep_Item (Base_Typ));
|
||||
Set_Scalar_Range (Implicit_Base, Scalar_Range (Base_Typ));
|
||||
|
||||
Set_Ekind (T, E_Signed_Integer_Subtype);
|
||||
Set_Etype (T, Implicit_Base);
|
||||
|
||||
Set_Scalar_Range (Implicit_Base, Scalar_Range (Base_Typ));
|
||||
|
||||
Set_Size_Info (T, (Implicit_Base));
|
||||
Set_First_Rep_Item (T, First_Rep_Item (Implicit_Base));
|
||||
Set_Scalar_Range (T, Def);
|
||||
Set_RM_Size (T, UI_From_Int (Minimum_Size (T)));
|
||||
Set_Is_Constrained (T);
|
||||
Set_Ekind (T, E_Signed_Integer_Subtype);
|
||||
Set_Etype (T, Implicit_Base);
|
||||
Set_Size_Info (T, Implicit_Base);
|
||||
Inherit_Rep_Item_Chain (T, Implicit_Base);
|
||||
Set_Scalar_Range (T, Def);
|
||||
Set_RM_Size (T, UI_From_Int (Minimum_Size (T)));
|
||||
Set_Is_Constrained (T);
|
||||
end Signed_Integer_Type_Declaration;
|
||||
|
||||
end Sem_Ch3;
|
||||
|
|
|
@ -7617,6 +7617,17 @@ package body Sem_Ch4 is
|
|||
Rewrite (First_Actual, Obj);
|
||||
end if;
|
||||
|
||||
-- The operation is obtained from the dispatch table and not by
|
||||
-- visibility, and may be declared in a unit that is not explicitly
|
||||
-- referenced in the source, but is nevertheless required in the
|
||||
-- context of the current unit. Indicate that operation and its scope
|
||||
-- are referenced, to prevent spurious and misleading warnings. If
|
||||
-- the operation is overloaded, all primitives are in the same scope
|
||||
-- and we can use any of them.
|
||||
|
||||
Set_Referenced (Entity (Subprog), True);
|
||||
Set_Referenced (Scope (Entity (Subprog)), True);
|
||||
|
||||
Rewrite (Node_To_Replace, Call_Node);
|
||||
|
||||
-- Propagate the interpretations collected in subprog to the new
|
||||
|
|
|
@ -454,24 +454,20 @@ package body Sem_Ch6 is
|
|||
|
||||
Analyze (N);
|
||||
|
||||
-- Within a generic we only need to analyze the expression. The body
|
||||
-- only needs to be constructed when generating code.
|
||||
-- Within a generic pre-analyze the original expression for name
|
||||
-- capture. The body is also generated but plays no role in
|
||||
-- this because it is not part of the original source.
|
||||
|
||||
if Inside_A_Generic then
|
||||
declare
|
||||
Id : constant Entity_Id := Defining_Entity (N);
|
||||
Save_In_Spec_Expression : constant Boolean
|
||||
:= In_Spec_Expression;
|
||||
|
||||
begin
|
||||
Set_Has_Completion (Id);
|
||||
In_Spec_Expression := True;
|
||||
Push_Scope (Id);
|
||||
Install_Formals (Id);
|
||||
Preanalyze_And_Resolve (Expr, Etype (Id));
|
||||
Preanalyze_Spec_Expression (Expr, Etype (Id));
|
||||
End_Scope;
|
||||
In_Spec_Expression := Save_In_Spec_Expression;
|
||||
return;
|
||||
end;
|
||||
end if;
|
||||
|
||||
|
|
|
@ -5737,7 +5737,17 @@ package body Sem_Eval is
|
|||
-- same base type.
|
||||
|
||||
if Has_Discriminants (T1) /= Has_Discriminants (T2) then
|
||||
if In_Instance then
|
||||
-- A generic actual type is declared through a subtype declaration
|
||||
-- and may have an inconsistent indication of the presence of
|
||||
-- discriminants, so check the type it renames.
|
||||
|
||||
if Is_Generic_Actual_Type (T1)
|
||||
and then not Has_Discriminants (Etype (T1))
|
||||
and then not Has_Discriminants (T2)
|
||||
then
|
||||
return True;
|
||||
|
||||
elsif In_Instance then
|
||||
if Is_Private_Type (T2)
|
||||
and then Present (Full_View (T2))
|
||||
and then Has_Discriminants (Full_View (T2))
|
||||
|
|
|
@ -9290,6 +9290,37 @@ package body Sem_Util is
|
|||
end if;
|
||||
end Inherit_Default_Init_Cond_Procedure;
|
||||
|
||||
----------------------------
|
||||
-- Inherit_Rep_Item_Chain --
|
||||
----------------------------
|
||||
|
||||
procedure Inherit_Rep_Item_Chain (Typ : Entity_Id; From_Typ : Entity_Id) is
|
||||
From_Item : constant Node_Id := First_Rep_Item (From_Typ);
|
||||
Item : Node_Id;
|
||||
|
||||
begin
|
||||
-- Reach the end of the destination type's chain (if any). The traversal
|
||||
-- ensures that we do not go past the last item.
|
||||
|
||||
Item := First_Rep_Item (Typ);
|
||||
while Present (Item) and then Present (Next_Rep_Item (Item)) loop
|
||||
Item := Next_Rep_Item (Item);
|
||||
end loop;
|
||||
|
||||
-- When the destination type has a rep item chain, the chain of the
|
||||
-- source type is appended to it.
|
||||
|
||||
if Present (Item) then
|
||||
Set_Next_Rep_Item (Item, From_Item);
|
||||
|
||||
-- Otherwise the destination type directly inherits the rep item chain
|
||||
-- of the source type.
|
||||
|
||||
else
|
||||
Set_First_Rep_Item (Typ, From_Item);
|
||||
end if;
|
||||
end Inherit_Rep_Item_Chain;
|
||||
|
||||
---------------------------------
|
||||
-- Insert_Explicit_Dereference --
|
||||
---------------------------------
|
||||
|
|
|
@ -1083,6 +1083,10 @@ package Sem_Util is
|
|||
-- Inherit the default initial condition procedure from the parent type of
|
||||
-- derived type Typ.
|
||||
|
||||
procedure Inherit_Rep_Item_Chain (Typ : Entity_Id; From_Typ : Entity_Id);
|
||||
-- Inherit the rep item chain of type From_Typ without clobbering any
|
||||
-- existing rep items on Typ's chain. Typ is the destination type.
|
||||
|
||||
procedure Insert_Explicit_Dereference (N : Node_Id);
|
||||
-- In a context that requires a composite or subprogram type and where a
|
||||
-- prefix is an access type, rewrite the access type node N (which is the
|
||||
|
|
Loading…
Reference in New Issue