+2010-10-05 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb: Do not elaborate type definition if syntax error.
+
+2010-10-05 Javier Miranda <miranda@adacore.com>
+
+ * sprint.adb (Sprint_Node_Actual): Improve output of subprogram bodies
+ to generate the full-qualified names of its corresponding spec.
+ This facilitates locating the corresponing body when reading
+ the DG output.
+
+2010-10-05 Thomas Quinot <quinot@adacore.com>
+
+ * exp_dist.adb (Make_Helper_Function_Name): For a tagged type, use
+ canonical name without serial number only if the helper is becoming a
+ primitive of the type.
+
+2010-10-05 Javier Miranda <miranda@adacore.com>
+
+ * exp_disp.adb (Make_DT): Minor code reorganization.
+
+2010-10-05 Ed Schonberg <schonberg@adacore.com>
+
+ * par-ch6.adb: improve recovery with extra paren in function spec.
+
+2010-10-05 Quentin Ochem <ochem@adacore.com>
+
+ * prj-tree.ads: Project_Path is now aliased.
+
+2010-10-05 Thomas Quinot <quinot@adacore.com>
+
+ * checks.adb: Minor reformatting.
+
+2010-10-05 Eric Botcazou <ebotcazou@adacore.com>
+
+ * mlib-tgt-specific-mingw.adb (No_Argument_List): Delete.
+ (Shared_Libgcc): New aliased variable.
+ (Shared_Libgcc_Switch): New constant.
+ (Build_Dynamic_Library): Pass Shared_Libgcc_Switch to the compiler
+ * gcc-interface/Makefile.in (gnatlib-shared-win32): Pass -shared-libgcc
+ to the compiler.
+ * gcc-interface/Make-lang.in: Update dependencies.
+
+2010-10-05 Vincent Celier <celier@adacore.com>
+
+ * prj-part.adb (Parse_Simple_Project): When checking if a child project
+ imports its parent project, also look in projects being extended by
+ imported projects.
+
+2010-10-05 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat_ugn.texi: Adjust instructions in G.10 Building DLLs with GNAT.
+
+2010-10-05 Javier Miranda <miranda@adacore.com>
+
+ * exp_cg.adb (Slot_Number): Add support to handle aliased entities.
+ (Generate_CG_Output): Switch -gnatd.Z is no longer needed to
+ activate this output.
+
+2010-10-05 Arnaud Charlet <charlet@adacore.com>
+
+ * back_end.adb (Call_Back_End): Generate an error message when scil
+ generation is enabled, and no scil back-end (by default) is available.
+
+2010-10-05 Javier Miranda <miranda@adacore.com>
+
+ * debug.adb: Update documentation because -gnatd.Z is no longer required
+ to generate the call-graph information.
+
+2010-10-05 Javier Miranda <miranda@adacore.com>
+
+ * exp_ch5.adb (Expand_Simple_Function_Return): Rewrite expansion of a
+ runtime access check by an equivalent expansion that causes
+ no problems in the VM backend. The original expansion was
+ not good for the VM backends because when Tagged_Type_Expansion
+ is disabled the attribute Access_Disp_Table is not available.
+
+2010-10-05 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_type.adb (Covers): In a dispatching context, T1 covers T2 if T2
+ is class-wide and T1 is its specific type.
+
+2010-10-05 Ed Schonberg <schonberg@adacore.com>
+
+ * einfo.adb: Add guard to Is_String_Type to prevent cascaded errors.
+
+2010-10-05 Vincent Celier <celier@adacore.com>
+
+ * back_end.ads: Minor spelling error correction.
+
+2010-10-05 Arnaud Charlet <charlet@adacore.com>
+
+ * switch-c.adb, gnat1drv.adb (Scan_Front_End_Switches): Disable
+ warnings when -gnatC is specified here so that warnings can be
+ re-enabled explicitly.
+ (Adjust_Global_Switches): No longer suppress warnings.
+
+2010-10-05 Vincent Celier <celier@adacore.com>
+
+ * makeutl.adb: Minor reformatting.
+
+2010-10-05 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch4.adb: add guard in Analyze_One_Call to prevent crash when a
+ non-discrete type appears as an actual in a call.
+
+2010-10-05 Vincent Celier <celier@adacore.com>
+
+ * make.adb (Scan_Make_Arg): Take into account new switch
+ --source-info=file.
+ * makeusg.adb: Add line for new switch --source-info=file.
+ * makeutl.ads (Source_Info_Option): New constant String for new builder
+ switch.
+ * prj-conf.adb: Put subprograms in alphabetical order
+ (Process_Project_And_Apply_Config): Read/write an eventual source info
+ file, if necessary.
+ * prj-nmsc.adb (Look_For_Sources.Get_Sources_From_Source_Info): New
+ procedure.
+ (Look_For_Sources): If a source info file was successfully read, get the
+ source data from the data read from the source info file.
+ * prj-util.adb (Source_Info_Table): New table
+ (Source_Info_Project_HTable): New hash table
+ (Create): New procedure
+ (Put (File), Put_Line): New procedures
+ (Write_Source_Info_File): New procedure
+ (Read_Source_Info_File): New procedure
+ (Initialize): New procedure
+ (Source_Info_Of): New procedure
+ (Next): New procedure
+ (Close): When file is an out file, fail if the buffer cannot be written
+ or if the file cannot be close successfully.
+ (Get_Line): Fail if file is an out file
+ * prj-util.ads (Create): New procedure
+ (Put (File), Put_Line): New procedures
+ (Write_Source_Info_File): New procedure
+ (Read_Source_Info_File): New procedure
+ (Source_Info_Data): New record type
+ (Source_Info_Iterator): New private type
+ (Initialize): New procedure
+ (Source_Info_Of): New procedure
+ (Next): New procedure
+ * prj.ads (Project_Tree_Data): New components Source_Info_File_Name and
+ Source_Info_File_Exists.
+
2010-10-05 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb: Fix typo.
with Atree; use Atree;
with Debug; use Debug;
with Elists; use Elists;
+with Errout; use Errout;
with Lib; use Lib;
with Osint; use Osint;
with Opt; use Opt;
File_Info_Array (J).Num_Source_Lines := Num_Source_Lines (J);
end loop;
+ if Generate_SCIL then
+ Error_Msg_N ("'S'C'I'L generation not available", Cunit (Main_Unit));
+
+ if CodePeer_Mode
+ or else (Mode /= Generate_Object
+ and then not Back_Annotate_Rep_Info)
+ then
+ return;
+ end if;
+ end if;
+
gigi
(gnat_root => Int (Cunit (Main_Unit)),
max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1),
Declarations_Only,
-- Partial back end operation with no object file generation. In this
-- mode the only useful action performed by gigi is to process all
- -- declarations issuing any error messages (in partcicular those to
+ -- declarations issuing any error messages (in particular those to
-- do with rep clauses), and to back annotate representation info.
Skip);
end if;
end if;
- -- If this is a boolean expression, only its elementary consituents need
+ -- If this is a boolean expression, only its elementary operands need
-- checking: if they are valid, a boolean or short-circuit operation
-- with them will be valid as well.
if Base_Type (Typ) = Standard_Boolean
- and then
- (Nkind (Expr) in N_Op or else Nkind (Expr) in N_Short_Circuit)
+ and then
+ (Nkind (Expr) in N_Op or else Nkind (Expr) in N_Short_Circuit)
then
return;
end if;
-- d.W Print out debugging information for Walk_Library_Items
-- d.X Use Expression_With_Actions
-- d.Y Do not use Expression_With_Actions
- -- d.Z Generate call-graph information
+ -- d.Z
-- d1 Error msgs have node numbers where possible
-- d2 Eliminate error flags in verbose form error messages
begin
return Ekind (Id) in String_Kind
or else (Is_Array_Type (Id)
+ and then Id /= Any_Composite
and then Number_Dimensions (Id) = 1
and then Is_Character_Type (Component_Type (Id)));
end Is_String_Type;
E_Generic_Package =>
Write_Str ("Renamed_Entity");
- when Incomplete_Or_Private_Kind =>
+ when Incomplete_Or_Private_Kind |
+ E_Record_Subtype =>
Write_Str ("Private_Dependents");
when Concurrent_Kind =>
------------------------------------------------------------------------------
with Atree; use Atree;
-with Debug; use Debug;
with Einfo; use Einfo;
with Elists; use Elists;
with Exp_Disp; use Exp_Disp;
begin
-- No output if the "ci" output file has not been previously opened
- -- by toplev.c. Temporarily the output is also disabled with -gnatd.Z
+ -- by toplev.c
- if Callgraph_Info_File = Null_Address
- or else not Debug_Flag_Dot_ZZ
- then
+ if Callgraph_Info_File = Null_Address then
return;
end if;
-----------------
function Slot_Number (Prim : Entity_Id) return Uint is
+ E : constant Entity_Id := Ultimate_Alias (Prim);
begin
- if Is_Predefined_Dispatching_Operation (Prim) then
- return -DT_Position (Prim);
+ if Is_Predefined_Dispatching_Operation (E) then
+ return -DT_Position (E);
else
- return DT_Position (Prim);
+ return DT_Position (E);
end if;
end Slot_Number;
with Checks; use Checks;
with Debug; use Debug;
with Einfo; use Einfo;
-with Elists; use Elists;
with Exp_Atag; use Exp_Atag;
with Exp_Aggr; use Exp_Aggr;
with Exp_Ch6; use Exp_Ch6;
Make_Selected_Component (Loc,
Prefix => Duplicate_Subexpr (Exp),
Selector_Name =>
- New_Reference_To (First_Tag_Component (Utyp), Loc)),
+ Make_Identifier (Loc, Chars => Name_uTag)),
Right_Opnd =>
- Unchecked_Convert_To (RTE (RE_Tag),
- New_Reference_To
- (Node (First_Elmt
- (Access_Disp_Table (Base_Type (Utyp)))),
- Loc))),
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Base_Type (Utyp), Loc),
+ Attribute_Name => Name_Tag)),
Reason => CE_Tag_Check_Failed));
-- If the result type is a specific nonlimited tagged type, then we
declare
Prim_Elmt : Elmt_Id;
Prim : Entity_Id;
+ Size_Comp : Node_Id;
begin
Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
Prim := Ultimate_Alias (Prim);
if Is_Abstract_Subprogram (Prim) then
- Append_To (TSD_Aggr_List,
+ Size_Comp :=
Unchecked_Convert_To (RTE (RE_Size_Ptr),
- New_Reference_To (RTE (RE_Null_Address), Loc)));
+ New_Reference_To (RTE (RE_Null_Address), Loc));
else
- Append_To (TSD_Aggr_List,
+ Size_Comp :=
Unchecked_Convert_To (RTE (RE_Size_Ptr),
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (Prim, Loc),
- Attribute_Name => Name_Unrestricted_Access)));
+ Attribute_Name => Name_Unrestricted_Access));
end if;
exit;
Next_Elmt (Prim_Elmt);
end loop;
+
+ pragma Assert (Present (Size_Comp));
+ Append_To (TSD_Aggr_List, Size_Comp);
end;
end if;
end if;
if Is_Itype (Typ) and then Typ /= Base_Type (Typ) then
Build_TypeCode_Function
(Loc => Loc,
- Typ => Etype (Typ),
- Decl => Decl,
- Fnam => Fnam);
+ Typ => Etype (Typ),
+ Decl => Decl,
+ Fnam => Fnam);
return;
end if;
begin
declare
Serial : Nat := 0;
- -- For tagged types, we use a canonical name so that it matches
- -- the primitive spec. For all other cases, we use a serialized
- -- name so that multiple generations of the same procedure do
- -- not clash.
+ -- For tagged types that aren't frozen yet, generate the helper
+ -- under its canonical name so that it matches the primitive
+ -- spec. For all other cases, we use a serialized name so that
+ -- multiple generations of the same procedure do not clash.
begin
- if not Is_Tagged_Type (Typ) then
+ if Is_Tagged_Type (Typ) and then not Is_Frozen (Typ) then
+ null;
+
+ else
Serial := Increment_Serial_Number;
end if;
- -- Use prefixed underscore to avoid potential clash with used
+ -- Use prefixed underscore to avoid potential clash with user
-- identifier (we use attribute names for Nam).
return
Make_Defining_Identifier (Loc,
Chars =>
New_External_Name
- (Related_Id => Nam,
- Suffix => ' ', Suffix_Index => Serial,
- Prefix => '_'));
+ (Related_Id => Nam,
+ Suffix => ' ',
+ Suffix_Index => Serial,
+ Prefix => '_'));
end;
end Make_Helper_Function_Name;
end Helpers;
ada/casing.ads ada/checks.ads ada/checks.adb ada/debug.ads \
ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
- ada/exp_aggr.ads ada/exp_atag.ads ada/exp_ch11.ads ada/exp_ch2.ads \
- ada/exp_ch3.ads ada/exp_ch3.adb ada/exp_ch4.ads ada/exp_ch6.ads \
- ada/exp_ch7.ads ada/exp_ch9.ads ada/exp_disp.ads ada/exp_dist.ads \
- ada/exp_pakd.ads ada/exp_smem.ads ada/exp_strm.ads ada/exp_tss.ads \
- ada/exp_tss.adb ada/exp_util.ads ada/exp_util.adb ada/fname.ads \
- ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
- ada/g-htable.ads ada/hostparm.ads ada/inline.ads ada/itypes.ads \
+ ada/exp_aggr.ads ada/exp_atag.ads ada/exp_cg.ads ada/exp_ch11.ads \
+ ada/exp_ch2.ads ada/exp_ch3.ads ada/exp_ch3.adb ada/exp_ch4.ads \
+ ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_ch9.ads ada/exp_dbug.ads \
+ ada/exp_disp.ads ada/exp_disp.adb ada/exp_dist.ads ada/exp_pakd.ads \
+ ada/exp_smem.ads ada/exp_strm.ads ada/exp_tss.ads ada/exp_tss.adb \
+ ada/exp_util.ads ada/exp_util.adb ada/fname.ads ada/fname-uf.ads \
+ ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
+ ada/hostparm.ads ada/inline.ads ada/itypes.ads ada/layout.ads \
ada/lib.ads ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads \
ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
- ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/sem.ads \
- ada/sem_attr.ads ada/sem_aux.ads ada/sem_aux.adb ada/sem_cat.ads \
- ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads \
- ada/sem_eval.ads ada/sem_mech.ads ada/sem_res.ads ada/sem_scil.ads \
- ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \
- ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \
- ada/stand.ads ada/stringt.ads ada/system.ads ada/s-exctab.ads \
- ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
- ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
- ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
- ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
- ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
- ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
- ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
- ada/unchdeal.ads ada/urealp.ads ada/validsw.ads
+ ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/scil_ll.ads \
+ ada/sem.ads ada/sem_attr.ads ada/sem_aux.ads ada/sem_aux.adb \
+ ada/sem_cat.ads ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch7.ads \
+ ada/sem_ch8.ads ada/sem_disp.ads ada/sem_eval.ads ada/sem_mech.ads \
+ ada/sem_res.ads ada/sem_scil.ads ada/sem_type.ads ada/sem_util.ads \
+ ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
+ ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \
+ ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
+ ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
+ ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
+ ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
+ ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
+ ada/targparm.ads ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
+ ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
+ ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads
ada/exp_ch4.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
THREAD_KIND="$(THREAD_KIND)" \
gnatlib
$(RM) $(RTSDIR)/libgna*$(soext)
- cd $(RTSDIR); ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
+ cd $(RTSDIR); ../../xgcc -B../../ -shared -shared-libgcc \
+ $(TARGET_LIBGCC2_CFLAGS) \
-o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS) \
$(SO_OPTS)libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) $(MISCLIB)
- cd $(RTSDIR); ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
+ cd $(RTSDIR); ../../xgcc -B../../ -shared -shared-libgcc \
+ $(TARGET_LIBGCC2_CFLAGS) \
-o libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(GNATRTL_TASKING_OBJS) \
$(SO_OPTS)libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
Assertions_Enabled := True;
Debug_Pragmas_Enabled := True;
- -- Suppress compiler warnings, since what we are interested in here
- -- is what CodePeer can find out. Also disable all simple value
- -- propagation. This is an optimization which is valuable for code
- -- optimization, and also for generation of compiler warnings, but
- -- these are being turned off anyway, and CodePeer understands
- -- things more clearly if references are not optimized in this way.
-
- Warning_Mode := Suppress;
+ -- Disable all simple value propagation. This is an optimization
+ -- which is valuable for code optimization, and also for generation
+ -- of compiler warnings, but these are being turned off by default,
+ -- and CodePeer generates better messages (referencing original
+ -- variables) this way.
+
Debug_Flag_MM := True;
-- Set normal RM validity checking, and checking of IN OUT parameters
@item building the DLL
-To build the DLL you must use @command{gcc}'s @option{-shared}
-option. It is quite simple to use this method:
+To build the DLL you must use @command{gcc}'s @option{-shared} and
+@option{-shared-libgcc} options. It is quite simple to use this method:
@smallexample
-$ gcc -shared -o api.dll obj1.o obj2.o @dots{}
+$ gcc -shared -shared-libgcc -o api.dll obj1.o obj2.o @dots{}
@end smallexample
It is important to note that in this case all symbols found in the
file, @pxref{The Definition File}. For example:
@smallexample
-$ gcc -shared -o api.dll api.def obj1.o obj2.o @dots{}
+$ gcc -shared -shared-libgcc -o api.dll api.def obj1.o obj2.o @dots{}
@end smallexample
If you use a definition file you must export the elaboration procedures
with Ada.Command_Line; use Ada.Command_Line;
-with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-
with GNAT.Case_Util; use GNAT.Case_Util;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.HTable;
package body Makeutl is
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
function PIC_Option return String;
- No_Argument_List : constant String_List := (1 .. 0 => null);
- -- Used as value of parameter Options or Options2 in calls to Gcc
+ Shared_Libgcc : aliased String := "-shared-libgcc";
+
+ Shared_Libgcc_Switch : constant Argument_List :=
+ (1 => Shared_Libgcc'Access);
---------------------------
-- Build_Dynamic_Library --
Tools.Gcc
(Output_File => Lib_File,
Objects => Ofiles,
- Options => No_Argument_List,
+ Options => Shared_Libgcc_Switch,
Options_2 => Options,
Driver_Name => Driver_Name);
end Build_Dynamic_Library;
-- case is for subunits.
if Pf_Flags /= Pf_Decl_Gins_Pbod_Rnam_Stub
- and then
- Pf_Flags /= Pf_Decl_Pbod
- and then
- Pf_Flags /= Pf_Pbod
+ and then Pf_Flags /= Pf_Decl_Pbod
+ and then Pf_Flags /= Pf_Pbod
then
Error_Msg_SC ("overriding indicator not allowed here!");
end if;
else
+ -- Skip extra parenthesis at end of formal part, and if
+ -- function scan result subtype.
+
+ Ignore (Tok_Right_Paren);
+
if Func then
- Ignore (Tok_Right_Paren);
TF_Return;
+
+ if Prev_Token = Tok_Return then
+ Result_Node := P_Subtype_Mark;
+ end if;
end if;
end if;
Parent_Node : Project_Node_Id := Empty_Node;
With_Clause : Project_Node_Id :=
First_With_Clause_Of (Project, In_Tree);
+ Imp_Proj_Name : Name_Id;
begin
-- If there is an extended project, check its name
-- If the parent project is not the extended project,
-- check each imported project until we find the parent project.
+ Imported_Loop :
while not Parent_Found and then Present (With_Clause) loop
Parent_Node := Project_Node_Of (With_Clause, In_Tree);
- Parent_Found := Name_Of (Parent_Node, In_Tree) = Parent_Name;
+
+ Extension_Loop :
+ while Present (Parent_Node) loop
+ Imp_Proj_Name := Name_Of (Parent_Node, In_Tree);
+ Parent_Found := Imp_Proj_Name = Parent_Name;
+ exit Imported_Loop when Parent_Found;
+ Parent_Node :=
+ Extended_Project_Of
+ (Project_Declaration_Of (Parent_Node, In_Tree),
+ In_Tree);
+ end loop Extension_Loop;
+
With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
- end loop;
+ end loop Imported_Loop;
if Parent_Found then
Set_Parent_Project_Of (Project, In_Tree, To => Parent_Node);
-- The target name, if any, specified with the gprbuild or gprclean
-- switch --target=.
- Project_Path : Prj.Env.Project_Search_Path;
+ Project_Path : aliased Prj.Env.Project_Search_Path;
-- The project path is tree specific, since we might want to load
-- simultaneously multiple projects, each with its own search path, in
-- particular when using different compilers with different default
when N_Record_Definition =>
Record_Type_Declaration (T, N, Prev);
+ -- If declaration has a parse error, nothing to elaborate.
+
+ when N_Error =>
+ null;
+
when others =>
raise Program_Error;
and then Is_Type (Entity (Actual))
and then No (Next (Actual))
then
- Rewrite (N,
- Make_Slice (Loc,
- Prefix => Make_Function_Call (Loc,
- Name => Relocate_Node (Name (N))),
+ -- A single actual that is a type name indicates a slice if the
+ -- type is discrete, and an error otherwise.
+
+ if Is_Discrete_Type (Entity (Actual)) then
+ Rewrite (N,
+ Make_Slice (Loc,
+ Prefix => Make_Function_Call (Loc,
+ Name => Relocate_Node (Name (N))),
Discrete_Range =>
- New_Occurrence_Of (Entity (Actual), Sloc (Actual))));
+ New_Occurrence_Of (Entity (Actual), Sloc (Actual))));
+
+ Analyze (N);
+
+ else
+ Error_Msg_N ("invalid use of type in expression", Actual);
+ Set_Etype (N, Any_Type);
+ end if;
- Analyze (N);
return True;
elsif not Has_Compatible_Type (Actual, Etype (Index)) then
return False;
end;
- -- In a dispatching call the actual may be class-wide
+ -- In a dispatching call the actual may be class-wide, the formal
+ -- may be its specific type, or that of a descendent of it.
elsif Is_Class_Wide_Type (T2)
- and then Base_Type (Root_Type (T2)) = Base_Type (T1)
+ and then
+ (Class_Wide_Type (T1) = T2
+ or else Base_Type (Root_Type (T2)) = Base_Type (T1))
then
return True;
end if;
Write_Indent;
- Sprint_Node_Sloc (Specification (Node));
+
+ if Present (Corresponding_Spec (Node)) then
+ Sprint_Node_Sloc (Parent (Corresponding_Spec (Node)));
+ else
+ Sprint_Node_Sloc (Specification (Node));
+ end if;
+
Write_Str (" is");
Sprint_Indented_List (Declarations (Node));
when 'C' =>
Ptr := Ptr + 1;
- CodePeer_Mode := True;
+
+ if not CodePeer_Mode then
+ CodePeer_Mode := True;
+
+ -- Suppress compiler warnings by default, since what we are
+ -- interested in here is what CodePeer can find out. Note
+ -- that if -gnatwxxx is specified after -gnatC on the
+ -- command line, we do not want to override this setting in
+ -- Adjust_Global_Switches, and assume that the user wants to
+ -- get both warnings from GNAT and CodePeer messages.
+
+ Warning_Mode := Suppress;
+ end if;
-- Processing for d switch
projects / thirdparty / gcc.git / commitdiff
